ClickHaskell (empty) → 0.1.0
raw patch · 12 files changed
+2551/−0 lines, 12 filesdep +basedep +binarydep +bytestringsetup-changed
Dependencies added: base, binary, bytestring, deepseq, network, text, time, vector, wide-word
Files
- ChangeLog.md +0/−0
- ClickHaskell.cabal +108/−0
- ClickHaskell.hs +418/−0
- ClickHaskell/Columns.hs +564/−0
- ClickHaskell/DbTypes.hs +553/−0
- ClickHaskell/DeSerialization.hs +218/−0
- ClickHaskell/NativeProtocol.hs +443/−0
- ClickHaskell/Parameters.hs +123/−0
- ClickHaskell/Versioning.hs +86/−0
- LICENSE +30/−0
- README.md +6/−0
- Setup.hs +2/−0
+ ChangeLog.md view
+ ClickHaskell.cabal view
@@ -0,0 +1,108 @@+Cabal-version: 3.4+++Name: ClickHaskell+Version: 0.1.0++Author: Kovalev Dmitry+Maintainer: Kovalev Dmitry+Category: ClickHouse+Synopsis: ClickHouse driver+Description: Small dependency footprint highlevel ClickHouse driver +Homepage: https://github.com/KovalevDima/ClickHaskell#readme+Bug-reports: https://github.com/KovalevDima/ClickHaskell/issues+License: BSD-3-Clause+License-File: LICENSE+Copyright: 2023 Kovalev Dmitry+Build-Type: Simple++extra-doc-files:+ README.md+ ChangeLog.md++Flag release+ Description: Pre-release build options+ Manual: True+ Default: False++Flag dev+ Description: Dump core+ Manual: True+ Default: False+++Source-repository head+ Type: git+ Location: https://github.com/KovalevDima/ClickHaskell+ Subdir: ClickHaskell+++Library+ Autogen-Modules:+ Paths_ClickHaskell+ Exposed-Modules:+ ClickHaskell+ ClickHaskell.DbTypes+ ClickHaskell.Parameters+ ClickHaskell.NativeProtocol+ ClickHaskell.DeSerialization+ ClickHaskell.Versioning+ Other-Modules:+ Paths_ClickHaskell+ ClickHaskell.Columns+ HS-Source-Dirs:+ ./+ default-extensions:+ AllowAmbiguousTypes+ DataKinds+ DefaultSignatures+ DeriveAnyClass+ DeriveGeneric+ DerivingStrategies+ InstanceSigs+ GADTs+ NamedFieldPuns+ StandaloneDeriving+ UndecidableInstances+ GHC-Options:+ -Wall+ -fno-warn-type-defaults+ -Wunused-packages++ if flag(release)+ GHC-Options: -Werror++ if flag(dev)+ GHC-Options:+ -ddump-to-file+ -ddump-simpl+ -dsuppress-type-applications+ -dsuppress-coercions+ -dsuppress-idinfo+ -dsuppress-type-signatures+ -dsuppress-var-kinds+ -dsuppress-module-prefixes+ -dsuppress-uniques++ Build-depends:+ -- GHC included libraries+ base >= 4.7 && <5+ , bytestring < 0.13+ , binary < 9+ , deepseq < 1.6+ , text < 2.2+ , time < 1.13+ , vector < 0.14++ -- External dependencies+ , network+ , wide-word < 0.2+ Default-language: Haskell2010+ Default-Extensions:+ FlexibleContexts+ FlexibleInstances+ MultiParamTypeClasses+ TypeApplications+ TypeFamilies+ TypeOperators+ ScopedTypeVariables
+ ClickHaskell.hs view
@@ -0,0 +1,418 @@+{-# LANGUAGE+ BangPatterns+ , ConstraintKinds+ , LambdaCase+ , NumericUnderscores+ , OverloadedStrings+ , RecordWildCards+#-}++module ClickHaskell+ (+ -- * Connection+ ChCredential(..), defaultCredentials+ , Connection(..), openNativeConnection++ -- * Reading and writing+ , Table+ , Columns, Column, KnownColumn(..), DeserializableColumn(..)++ -- ** Reading+ , ReadableFrom(..)+ -- *** Simple+ , select+ , selectFrom+ , selectFromView, View, parameter, Parameter+ -- *** Streaming+ , streamSelect+ , streamSelectFrom+ , streamSelectFromView+ -- *** Internal+ , handleSelect++ -- ** Writing+ , WritableInto(..)+ , insertInto++ -- * Ping database connection+ , ping+ ) where++-- Internal dependencies+import ClickHaskell.DbTypes+import ClickHaskell.NativeProtocol+ ( mkDataPacket, DataPacket(..)+ , mkHelloPacket, HelloParameters(..), mkAddendum+ , mkPingPacket+ , mkQueryPacket+ , ServerPacketType(..), HelloResponse(..), ExceptionPacket, latestSupportedRevision+ )+import ClickHaskell.Versioning (ProtocolRevision)+import ClickHaskell.Columns+ ( HasColumns (..), WritableInto (..), ReadableFrom (..)+ , Columns, DeserializableColumns (..)+ , Column, DeserializableColumn(..), KnownColumn(..)+ )+import ClickHaskell.Parameters (Parameter, parameter, parameters, Parameters, CheckParameters)+import ClickHaskell.DeSerialization (Serializable(..), Deserializable(..))++-- GHC included+import Control.Exception (Exception, SomeException, bracketOnError, catch, finally, throwIO)+import Control.DeepSeq (NFData, (<$!!>))+import Data.Binary.Get (Decoder (..), Get, runGetIncremental)+import Data.ByteString.Builder (byteString, toLazyByteString)+import Data.ByteString.Char8 as BS8 (fromStrict, pack)+import Data.ByteString.Lazy.Internal as BL (ByteString (..), LazyByteString)+import Data.Int (Int64)+import Data.Kind (Type)+import Data.Maybe (listToMaybe)+import Data.Text (Text)+import Data.Typeable (Proxy (..))+import GHC.Stack (HasCallStack, callStack, prettyCallStack)+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)+import System.Timeout (timeout)++-- External+import Network.Socket as Sock+import Network.Socket.ByteString.Lazy (recv, sendAll)++-- * Connection++data ChCredential = MkChCredential+ { chLogin :: Text+ , chPass :: Text+ , chDatabase :: Text+ , chHost :: HostName+ , chPort :: ServiceName+ }++defaultCredentials :: ChCredential+defaultCredentials = MkChCredential+ { chLogin = "default"+ , chPass = ""+ , chHost = "localhost"+ , chDatabase = "default"+ , chPort = "9000"+ }++data Connection = MkConnection+ { sock :: Socket+ , user :: ChString+ , bufferSize :: Int64+ , revision :: ProtocolRevision+ }++openNativeConnection :: HasCallStack => ChCredential -> IO Connection+openNativeConnection MkChCredential{chHost, chPort, chLogin, chPass, chDatabase} = do+ AddrInfo{addrFamily, addrSocketType, addrProtocol, addrAddress}+ <- (maybe (throwIO $ ConnectionError NoAdressResolved) pure . listToMaybe)+ =<< getAddrInfo+ (Just defaultHints{addrFlags = [AI_ADDRCONFIG], addrSocketType = Stream})+ (Just chHost)+ (Just chPort)+ sock <- maybe (throwIO $ ConnectionError EstablishTimeout) pure+ =<< timeout 3_000_000 (+ bracketOnError+ (socket addrFamily addrSocketType addrProtocol)+ (\sock ->+ catch @SomeException+ (finally+ (shutdown sock ShutdownBoth)+ (close sock)+ )+ (const $ pure ())+ )+ (\sock -> do+ setSocketOption sock NoDelay 1+ setSocketOption sock Sock.KeepAlive 1+ connect sock addrAddress+ pure sock+ )+ )++ (sendAll sock . toLazyByteString . serialize latestSupportedRevision)+ (mkHelloPacket MkHelloParameters{..})++ (serverPacketType, _) <- rawBufferizedRead emptyBuffer (deserialize latestSupportedRevision) sock 4096+ case serverPacketType of+ HelloResponse MkHelloResponse{server_revision} -> do+ let revision = min server_revision latestSupportedRevision+ (sendAll sock . toLazyByteString) (serialize revision mkAddendum)+ pure MkConnection+ { user = toChType chLogin+ , revision+ , sock+ , bufferSize = 4096+ }+ Exception exception -> throwIO (DatabaseException exception)+ otherPacket -> throwIO (ProtocolImplementationError $ UnexpectedPacketType otherPacket)+++-- * Ping++ping :: HasCallStack => Connection -> IO ()+ping conn@MkConnection{sock, revision} = do+ (sendAll sock . toLazyByteString)+ (serialize revision mkPingPacket)+ (responsePacket, _) <- continueReadDeserializable conn emptyBuffer+ case responsePacket of+ Pong -> pure ()+ Exception exception -> throwIO (DatabaseException exception)+ otherPacket -> throwIO (ProtocolImplementationError . UnexpectedPacketType $ otherPacket)+++++-- * Querying++data Table (name :: Symbol) (columns :: [Type])++instance HasColumns (Table name columns) where+ type GetColumns (Table _ columns) = columns++-- ** Selecting++-- *** Simple++selectFrom ::+ forall table record name columns+ .+ ( table ~ Table name columns+ , KnownSymbol name+ , ReadableFrom table record+ )+ =>+ Connection -> IO [record]+selectFrom conn@MkConnection{sock, user, revision} = do+ let query+ = "SELECT " <> readingColumns @table @record+ <> " FROM " <> (byteString . BS8.pack) (symbolVal $ Proxy @name)+ (sendAll sock . toLazyByteString)+ ( serialize revision (mkQueryPacket revision user (toChType query))+ <> serialize revision (mkDataPacket "" 0 0)+ )+ handleSelect @table conn emptyBuffer pure++select ::+ forall columns record+ .+ ReadableFrom (Columns columns) record+ =>+ Connection -> ChString -> IO [record]+select conn@MkConnection{sock, user, revision} query = do+ (sendAll sock . toLazyByteString)+ ( serialize revision (mkQueryPacket revision user query)+ <> serialize revision (mkDataPacket "" 0 0)+ )+ handleSelect @(Columns columns) conn emptyBuffer pure++instance HasColumns (View name columns parameters) where+ type GetColumns (View _ columns _) = columns++data View (name :: Symbol) (columns :: [Type]) (parameters :: [Type])++selectFromView ::+ forall view record name columns parameters passedParameters+ .+ ( ReadableFrom view record+ , KnownSymbol name+ , view ~ View name columns parameters+ , CheckParameters parameters passedParameters+ )+ => Connection -> (Parameters '[] -> Parameters passedParameters) -> IO [record]+selectFromView conn@MkConnection{..} interpreter = do+ let query =+ "SELECT " <> readingColumns @view @record <>+ " FROM " <> (byteString . BS8.pack . symbolVal @name) Proxy <> parameters interpreter+ (sendAll sock . toLazyByteString)+ ( serialize revision (mkQueryPacket revision user (toChType query))+ <> serialize revision (mkDataPacket "" 0 0)+ )+ handleSelect @view conn emptyBuffer pure++-- *** Streaming++streamSelectFrom ::+ forall table record name columns a+ .+ ( table ~ Table name columns+ , KnownSymbol name+ , ReadableFrom table record+ , NFData a+ )+ =>+ Connection -> ([record] -> IO [a]) -> IO [a]+streamSelectFrom conn@MkConnection{sock, user, revision} f = do+ let query+ = "SELECT " <> readingColumns @table @record+ <> " FROM " <> (byteString . BS8.pack) (symbolVal $ Proxy @name)+ (sendAll sock . toLazyByteString)+ ( serialize revision (mkQueryPacket revision user (toChType query))+ <> serialize revision (mkDataPacket "" 0 0)+ )+ let f' x = id <$!!> f x+ handleSelect @table conn emptyBuffer f'++streamSelect ::+ forall columns record a+ .+ (ReadableFrom (Columns columns) record, NFData a)+ =>+ Connection -> ChString -> ([record] -> IO [a]) -> IO [a]+streamSelect conn@MkConnection{sock, user, revision} query f = do+ (sendAll sock . toLazyByteString)+ ( serialize revision (mkQueryPacket revision user query)+ <> serialize revision (mkDataPacket "" 0 0)+ )+ let f' x = id <$!!> f x+ handleSelect @(Columns columns) conn emptyBuffer f'++streamSelectFromView ::+ forall view record name columns parameters passedParameters a+ .+ ( ReadableFrom view record+ , KnownSymbol name+ , view ~ View name columns parameters+ , NFData a+ , CheckParameters parameters passedParameters+ )+ => Connection -> (Parameters '[] -> Parameters passedParameters) -> ([record] -> IO [a]) -> IO [a]+streamSelectFromView conn@MkConnection{..} interpreter f = do+ let query =+ "SELECT " <> readingColumns @view @record <>+ " FROM " <> (byteString . BS8.pack . symbolVal @name) Proxy <> parameters interpreter+ (sendAll sock . toLazyByteString)+ ( serialize revision (mkQueryPacket revision user (toChType query))+ <> serialize revision (mkDataPacket "" 0 0)+ )+ let f' x = id <$!!> f x+ handleSelect @view conn emptyBuffer f'++-- *** Internal++handleSelect ::+ forall hasColumns record a+ .+ ReadableFrom hasColumns record+ =>+ Connection -> Buffer -> ([record] -> IO [a]) -> IO [a]+handleSelect conn previousBuffer f = do+ (packet, buffer) <- continueReadDeserializable @ServerPacketType conn previousBuffer+ case packet of+ DataResponse MkDataPacket{columns_count, rows_count} -> do+ case (columns_count, rows_count) of+ (0, 0) -> handleSelect @hasColumns conn buffer f+ (_, 0) -> do+ (_, nextBuffer) <- continueReadColumns @hasColumns @record conn buffer 0+ handleSelect @hasColumns conn nextBuffer f+ (_, rows) -> do+ (columns, nextBuffer) <- continueReadColumns @hasColumns conn buffer rows+ processedColumns <- f columns+ (processedColumns ++) <$> handleSelect @hasColumns conn nextBuffer f + Progress _ -> handleSelect @hasColumns conn buffer f+ ProfileInfo _ -> handleSelect @hasColumns conn buffer f+ EndOfStream -> pure []+ Exception exception -> throwIO (DatabaseException exception)+ otherPacket -> throwIO (ProtocolImplementationError $ UnexpectedPacketType otherPacket)+++-- ** Inserting++insertInto ::+ forall table record name columns+ .+ ( table ~ Table name columns+ , WritableInto table record+ , KnownSymbol name+ )+ => Connection -> [record] -> IO ()+insertInto conn@MkConnection{sock, user, revision} columnsData = do+ let query =+ "INSERT INTO " <> (byteString . BS8.pack) (symbolVal $ Proxy @name)+ <> " (" <> writingColumns @table @record <> ") VALUES"+ (sendAll sock . toLazyByteString)+ ( serialize revision (mkQueryPacket revision user (toChType query))+ <> serialize revision (mkDataPacket "" 0 0)+ )+ handleInsertResult @table conn emptyBuffer columnsData++handleInsertResult :: forall columns record . WritableInto columns record => Connection -> Buffer -> [record] -> IO ()+handleInsertResult conn@MkConnection{..} buffer records = do+ (firstPacket, buffer1) <- continueReadDeserializable @ServerPacketType conn buffer+ case firstPacket of+ TableColumns _ -> handleInsertResult @columns conn buffer1 records+ DataResponse packet -> do+ (_emptyDataPacket, buffer2) <- continueReadRawColumns @(Columns (GetColumns columns)) conn buffer1 (rows_count packet)+ (sendAll sock . toLazyByteString)+ ( serialize revision (mkDataPacket "" (columnsCount @columns @record) (fromIntegral $ length records))+ <> serializeRecords @columns revision (fromIntegral $ length records) records+ <> serialize revision (mkDataPacket "" 0 0)+ )+ handleInsertResult @columns @record conn buffer2 []+ EndOfStream -> pure ()+ Exception exception -> throwIO (DatabaseException exception)+ otherPacket -> throwIO (ProtocolImplementationError $ UnexpectedPacketType otherPacket)+++++-- * Reading++continueReadDeserializable :: Deserializable packet => Connection -> Buffer -> IO (packet, Buffer)+continueReadDeserializable MkConnection{..} buffer = rawBufferizedRead buffer (deserialize revision) sock bufferSize++continueReadColumns :: forall columns record . ReadableFrom columns record => Connection -> Buffer -> UVarInt -> IO ([record], Buffer)+continueReadColumns MkConnection{..} buffer rows = rawBufferizedRead buffer (deserializeColumns @columns revision rows) sock bufferSize++continueReadRawColumns :: forall columns . DeserializableColumns columns => Connection -> Buffer -> UVarInt -> IO (columns, Buffer)+continueReadRawColumns MkConnection{..} buffer rows = rawBufferizedRead buffer (deserializeRawColumns @columns revision rows) sock bufferSize++-- ** Bufferization++type Buffer = LazyByteString++emptyBuffer :: Buffer+emptyBuffer = BL.Empty++rawBufferizedRead :: Buffer -> Get packet -> Socket -> Int64 -> IO (packet, Buffer)+rawBufferizedRead buffer parser sock bufSize = runBufferReader (recv sock bufSize) (runGetIncremental parser) buffer++runBufferReader :: IO LazyByteString -> Decoder packet -> Buffer -> IO (packet, Buffer)+runBufferReader bufferFiller (Partial decoder) (BL.Chunk bs mChunk)+ = runBufferReader bufferFiller (decoder $ Just bs) mChunk+runBufferReader bufferFiller (Partial decoder) BL.Empty = do+ bufferFiller >>= \case+ BL.Empty -> throwIO (DeserializationError "Expected more bytes while reading packet")+ BL.Chunk bs mChunk -> runBufferReader bufferFiller (decoder $ Just bs) mChunk+runBufferReader _bufferFiller (Done leftover _consumed packet) _input = pure (packet, fromStrict leftover)+runBufferReader _initBuf (Fail _leftover _consumed msg) _buffer = throwIO (DeserializationError msg)+++++-- * Errors handling++data ClientError where+ ConnectionError :: HasCallStack => ConnectionError -> ClientError+ DatabaseException :: HasCallStack => ExceptionPacket -> ClientError+ ProtocolImplementationError :: HasCallStack => ProtocolImplementationError -> ClientError++instance Show ClientError where+ show (ConnectionError connError) = "ConnectionError" <> show connError <> "\n" <> prettyCallStack callStack+ show (DatabaseException exception) = "DatabaseException" <> show exception <> "\n" <> prettyCallStack callStack+ show (ProtocolImplementationError err) = "ConnectionError" <> show err <> "\n" <> prettyCallStack callStack++deriving anyclass instance Exception ClientError++{- |+ You shouldn't see this exceptions. Please report a bug if it appears+-}+data ProtocolImplementationError+ = UnexpectedPacketType ServerPacketType+ | DeserializationError String+ deriving (Show, Exception)++data ConnectionError+ = NoAdressResolved+ | EstablishTimeout+ deriving (Show, Exception)
+ ClickHaskell/Columns.hs view
@@ -0,0 +1,564 @@+{-# LANGUAGE+ ConstraintKinds+ , OverloadedStrings+ , TypeFamilyDependencies+ , TupleSections+ , LambdaCase+#-}++{-# OPTIONS_GHC+ -Wno-orphans+#-}++module ClickHaskell.Columns where++-- Internal dependencies+import ClickHaskell.DbTypes+import ClickHaskell.DeSerialization (Serializable (..), Deserializable(..))+import ClickHaskell.Versioning (ProtocolRevision, SinceRevision, DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION, afterRevision)++-- GHC included+import Control.Monad (forM, replicateM)+import Data.Binary (Get)+import Data.Bits+import Data.ByteString.Builder (Builder, stringUtf8)+import Data.Kind (Type)+import Data.Typeable (Proxy (..))+import Debug.Trace (traceShowId)+import GHC.Generics+import GHC.TypeLits (ErrorMessage (..), KnownSymbol, Symbol, TypeError, symbolVal)++-- * Columns++emptyColumns :: Columns '[]+emptyColumns = Empty++rowsCount :: Columns columns -> UVarInt+rowsCount (AddColumn col _) = columnSize col+rowsCount Empty = 0++{-# INLINE [0] appendColumn #-}+appendColumn+ :: KnownColumn (Column name chType)+ => Column name chType+ -> Columns columns+ -> Columns (Column name chType ': columns)+appendColumn = AddColumn+++data Columns (columns :: [Type]) where+ Empty :: Columns '[]+ AddColumn+ :: KnownColumn (Column name chType)+ => Column name chType+ -> Columns columns+ -> Columns (Column name chType ': columns)++{- |+Column declaration++For example:++@+type MyColumn = Column "myColumn" ChString+@+-}+data Column (name :: Symbol) (chType :: Type) where+ ChUInt8Column :: UVarInt -> [ChUInt8] -> Column name ChUInt8+ ChUInt16Column :: UVarInt -> [ChUInt16] -> Column name ChUInt16+ ChUInt32Column :: UVarInt -> [ChUInt32] -> Column name ChUInt32+ ChUInt64Column :: UVarInt -> [ChUInt64] -> Column name ChUInt64+ ChUInt128Column :: UVarInt -> [ChUInt128] -> Column name ChUInt128+ ChInt8Column :: UVarInt -> [ChInt8] -> Column name ChInt8+ ChInt16Column :: UVarInt -> [ChInt16] -> Column name ChInt16+ ChInt32Column :: UVarInt -> [ChInt32] -> Column name ChInt32+ ChInt64Column :: UVarInt -> [ChInt64] -> Column name ChInt64+ ChInt128Column :: UVarInt -> [ChInt128] -> Column name ChInt128+ ChDateColumn :: UVarInt -> [ChDate] -> Column name ChDate+ ChDateTimeColumn :: UVarInt -> [ChDateTime] -> Column name ChDateTime+ ChUUIDColumn :: UVarInt -> [ChUUID] -> Column name ChUUID+ ChStringColumn :: UVarInt -> [ChString] -> Column name ChString+ ChArrayColumn :: IsChType chType => UVarInt -> [ChArray chType] -> Column name (ChArray chType)+ NullableColumn :: IsChType chType => UVarInt -> [Nullable chType] -> Column name (Nullable chType)+ LowCardinalityColumn :: (IsLowCardinalitySupported chType, IsChType chType) => UVarInt -> [chType] -> Column name (LowCardinality chType)++type family GetColumnName column :: Symbol+ where+ GetColumnName (Column name columnType) = name++type family GetColumnType column :: Type+ where+ GetColumnType (Column name columnType) = columnType++class+ ( IsChType (GetColumnType column)+ , KnownSymbol (GetColumnName column)+ ) =>+ KnownColumn column where+ renderColumnName :: Builder+ renderColumnName = (stringUtf8 . symbolVal @(GetColumnName column)) Proxy++ renderColumnType :: Builder+ renderColumnType = chTypeName @(GetColumnType column)++ mkColumn :: UVarInt -> [GetColumnType column] -> Column (GetColumnName column) (GetColumnType column)++{-# INLINE [0] columnSize #-}+columnSize :: Column name chType -> UVarInt+columnSize column = case column of+ (ChUInt8Column size _listValues) -> size+ (ChUInt16Column size _listValues) -> size+ (ChUInt32Column size _listValues) -> size+ (ChUInt64Column size _listValues) -> size+ (ChUInt128Column size _listValues) -> size+ (ChInt8Column size _listValues) -> size+ (ChInt16Column size _listValues) -> size+ (ChInt32Column size _listValues) -> size+ (ChInt64Column size _listValues) -> size+ (ChInt128Column size _listValues) -> size+ (ChDateColumn size _nullableValues) -> size+ (ChDateTimeColumn size _nullableValues) -> size+ (ChUUIDColumn size _nullableValues) -> size+ (ChStringColumn size _values) -> size+ (ChArrayColumn size _nullableValues) -> size+ (NullableColumn size _nullableValues) -> size+ (LowCardinalityColumn size _lowCardinalityValues) -> size++{-# INLINE [0] columnValues #-}+columnValues :: Column name chType -> [chType]+columnValues column = case column of+ (ChUInt8Column _size values) -> values+ (ChUInt16Column _size values) -> values+ (ChUInt32Column _size values) -> values+ (ChUInt64Column _size values) -> values+ (ChUInt128Column _size values) -> values+ (ChInt8Column _size values) -> values+ (ChInt16Column _size values) -> values+ (ChInt32Column _size values) -> values+ (ChInt64Column _size values) -> values+ (ChInt128Column _size values) -> values+ (ChDateColumn _size values) -> values+ (ChDateTimeColumn _size values) -> values+ (ChUUIDColumn _size values) -> values+ (ChStringColumn _size values) -> values+ (ChArrayColumn _size arrayValues) -> arrayValues+ (NullableColumn _size nullableValues) -> nullableValues+ (LowCardinalityColumn _size lowCardinalityValues) -> map fromChType lowCardinalityValues++instance KnownSymbol name => KnownColumn (Column name ChUInt8) where mkColumn = ChUInt8Column+instance KnownSymbol name => KnownColumn (Column name ChUInt16) where mkColumn = ChUInt16Column+instance KnownSymbol name => KnownColumn (Column name ChUInt32) where mkColumn = ChUInt32Column+instance KnownSymbol name => KnownColumn (Column name ChUInt64) where mkColumn = ChUInt64Column+instance KnownSymbol name => KnownColumn (Column name ChUInt128) where mkColumn = ChUInt128Column+instance KnownSymbol name => KnownColumn (Column name ChInt8) where mkColumn = ChInt8Column+instance KnownSymbol name => KnownColumn (Column name ChInt16) where mkColumn = ChInt16Column+instance KnownSymbol name => KnownColumn (Column name ChInt32) where mkColumn = ChInt32Column+instance KnownSymbol name => KnownColumn (Column name ChInt64) where mkColumn = ChInt64Column+instance KnownSymbol name => KnownColumn (Column name ChInt128) where mkColumn = ChInt128Column+instance KnownSymbol name => KnownColumn (Column name ChDate) where mkColumn = ChDateColumn+instance KnownSymbol name => KnownColumn (Column name ChDateTime) where mkColumn = ChDateTimeColumn+instance KnownSymbol name => KnownColumn (Column name ChUUID) where mkColumn = ChUUIDColumn+instance+ ( KnownSymbol name+ , IsChType chType+ , IsChType (Nullable chType)+ ) =>+ KnownColumn (Column name (Nullable chType)) where mkColumn = NullableColumn+instance KnownSymbol name => KnownColumn (Column name ChString) where mkColumn = ChStringColumn+instance+ ( KnownSymbol name+ , IsChType (LowCardinality chType)+ , IsLowCardinalitySupported chType+ ) =>+ KnownColumn (Column name (LowCardinality chType)) where mkColumn size = LowCardinalityColumn size . map fromChType+instance KnownSymbol name => KnownColumn (Column name (ChArray ChString)) where mkColumn = ChArrayColumn+++-- ** Columns++instance+ Serializable (Columns '[])+ where+ {-# INLINE serialize #-}+ serialize _rev Empty = ""++instance+ ( Serializable (Columns columns)+ , Serializable col+ ) =>+ Serializable (Columns (col ': columns))+ where+ {-# INLINE serialize #-}+ serialize rev (AddColumn col columns) = serialize rev col <> serialize rev columns++instance+ ( KnownColumn (Column name chType)+ , IsChType chType+ , Serializable chType+ ) => Serializable (Column name chType) where+ {-# INLINE serialize #-}+ serialize rev column+ = serialize rev (toChType @ChString $ renderColumnName @(Column name chType))+ <> serialize rev (toChType @ChString $ renderColumnType @(Column name chType))+ -- serialization is not custom+ <> afterRevision @DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION rev (serialize @ChUInt8 rev 0)+ <> mconcat (Prelude.map (serialize @chType rev) (columnValues column))++instance {-# OVERLAPPING #-}+ ( KnownColumn (Column name (Nullable chType))+ , IsChType chType+ , Serializable chType+ ) => Serializable (Column name (Nullable chType)) where+ {-# INLINE serialize #-}+ serialize rev column+ = serialize rev (toChType @ChString $ renderColumnName @(Column name (Nullable chType)))+ <> serialize rev (toChType @ChString $ renderColumnType @(Column name (Nullable chType)))+ -- serialization is not custom+ <> afterRevision @DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION rev (serialize @ChUInt8 rev 0)+ -- Nulls+ <> mconcat (Prelude.map (serialize @ChUInt8 rev . maybe 1 (const 0)) (columnValues column))+ -- Values+ <> mconcat (Prelude.map (serialize @chType rev . maybe defaultValueOfTypeName id) (columnValues column))++instance {-# OVERLAPPING #-}+ ( KnownColumn (Column name (Nullable chType))+ , IsChType chType+ , Serializable chType+ , TypeError ('Text "LowCardinality serialization still unsupported")+ ) => Serializable (Column name (LowCardinality chType)) where+ {-# INLINE serialize #-}+ serialize rev (LowCardinalityColumn _ column)+ = serialize rev (toChType @ChString $ renderColumnName @(Column name (Nullable chType)))+ <> serialize rev (toChType @ChString $ renderColumnType @(Column name (Nullable chType)))+ -- serialization is not custom+ <> afterRevision @DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION rev (serialize @ChUInt8 rev 0)+ <> undefined column+++++++++++-- * (De)serialization++-- ** Serialization++-- *** Generic API++type GenericWritable record columns =+ ( Generic record+ , GWritable columns (Rep record)+ )++class+ ( HasColumns (Columns (GetColumns columns))+ , Serializable (Columns (GetColumns columns))+ , DeserializableColumns (Columns (GetColumns columns))+ ) =>+ WritableInto columns record+ where+ default serializeRecords :: GenericWritable record (GetColumns columns) => ProtocolRevision -> UVarInt -> [record] -> Builder+ serializeRecords :: ProtocolRevision -> UVarInt -> [record] -> Builder+ serializeRecords rev size = gSerializeRecords @(GetColumns columns) rev size . map from++ default writingColumns :: GenericWritable record (GetColumns columns) => Builder+ writingColumns :: Builder+ writingColumns = gWritingColumns @(GetColumns columns) @(Rep record)++ default columnsCount :: GenericWritable record (GetColumns columns) => UVarInt+ columnsCount :: UVarInt+ columnsCount = gColumnsCount @(GetColumns columns) @(Rep record)++class GWritable (columns :: [Type]) f+ where+ gSerializeRecords :: ProtocolRevision -> UVarInt -> [f p] -> Builder+ gWritingColumns :: Builder+ gColumnsCount :: UVarInt++instance+ GWritable columns f+ =>+ GWritable columns (D1 c (C1 c2 f))+ where+ {-# INLINE gSerializeRecords #-}+ gSerializeRecords rev size = gSerializeRecords @columns rev size . map (unM1 . unM1)+ {-# INLINE gWritingColumns #-}+ gWritingColumns = gWritingColumns @columns @f+ gColumnsCount = gColumnsCount @columns @f++instance+ GWritable columns (left1 :*: (left2 :*: right))+ =>+ GWritable columns ((left1 :*: left2) :*: right)+ where+ {-# INLINE gSerializeRecords #-}+ gSerializeRecords rev size = gSerializeRecords @columns rev size . map (\((l1 :*: l2) :*: r) -> l1 :*: (l2 :*: r))+ {-# INLINE gWritingColumns #-}+ gWritingColumns = gWritingColumns @columns @(left1 :*: (left2 :*: right))+ gColumnsCount = gColumnsCount @columns @(left1 :*: (left2 :*: right))++instance+ ( GWritable '[Column name chType] (S1 (MetaSel (Just name) a b f) rec)+ , GWritable restColumns right+ , '(Column name chType, restColumns)~ TakeColumn name columns+ )+ =>+ GWritable columns (S1 (MetaSel (Just name) a b f) rec :*: right)+ where+ {-# INLINE gSerializeRecords #-}+ gSerializeRecords rev size+ = (\(a, b) -> gSerializeRecords @'[Column name chType] rev size a <> gSerializeRecords @restColumns rev size b)+ . unzip . map (\(l :*: r) -> (l, r))++ {-# INLINE gWritingColumns #-}+ gWritingColumns =+ gWritingColumns @'[Column name chType] @(S1 (MetaSel (Just name) a b f) rec)+ <> ", " <> gWritingColumns @restColumns @right+ gColumnsCount = gColumnsCount @'[Column name chType] @(S1 (MetaSel (Just name) a b f) rec) + gColumnsCount @restColumns @right++instance {-# OVERLAPPING #-}+ ( KnownColumn (Column name chType)+ , ToChType chType inputType+ , Serializable (Column name chType)+ , '(Column name chType, restColumns) ~ TakeColumn name columns+ ) =>+ GWritable columns (S1 (MetaSel (Just name) a b f) (Rec0 inputType))+ where+ {-# INLINE gSerializeRecords #-}+ gSerializeRecords rev size = serialize rev . mkColumn @(Column name chType) size . map (toChType . unK1 . unM1)+ {-# INLINE gWritingColumns #-}+ gWritingColumns = renderColumnName @(Column name chType)+ gColumnsCount = 1+++++-- ** Deserialization++-- *** Generic API++type GenericReadable record hasColumns =+ ( Generic record+ , GReadable (GetColumns hasColumns) (Rep record)+ )++class+ ( HasColumns hasColumns+ , DeserializableColumns (Columns (GetColumns hasColumns))+ ) =>+ ReadableFrom hasColumns record+ where+ default deserializeColumns :: GenericReadable record hasColumns => ProtocolRevision -> UVarInt -> Get [record]+ deserializeColumns :: ProtocolRevision -> UVarInt -> Get [record]+ deserializeColumns rev size = map to <$> gFromColumns @(GetColumns hasColumns) rev size++ default readingColumns :: GenericReadable record hasColumns => Builder+ readingColumns :: Builder+ readingColumns = gReadingColumns @(GetColumns hasColumns) @(Rep record)+++class GReadable (columns :: [Type]) f+ where+ gFromColumns :: ProtocolRevision -> UVarInt -> Get [f p]+ gReadingColumns :: Builder++instance+ GReadable columns f+ =>+ GReadable columns (D1 c (C1 c2 f))+ where+ {-# INLINE gFromColumns #-}+ gFromColumns rev size = map (M1 . M1) <$> gFromColumns @columns rev size+ gReadingColumns = gReadingColumns @columns @f++instance+ GReadable columns (left :*: (right1 :*: right2))+ =>+ GReadable columns ((left :*: right1) :*: right2)+ where+ {-# INLINE gFromColumns #-}+ gFromColumns rev size = do+ list <- gFromColumns @columns rev size+ pure [(l :*: r1) :*: r2 | (l :*: (r1 :*: r2)) <- list]+ gReadingColumns = gReadingColumns @columns @(left :*: (right1 :*: right2))+++instance+ ( KnownColumn (Column name chType)+ , GReadable '[Column name chType] (S1 (MetaSel (Just name) a b f) rec)+ , GReadable restColumns right+ , '(Column name chType, restColumns) ~ TakeColumn name columns+ )+ =>+ GReadable columns (S1 (MetaSel (Just name) a b f) rec :*: right)+ where+ {-# INLINE gFromColumns #-}+ gFromColumns rev size = do+ zipWith (:*:)+ <$> gFromColumns @'[Column name chType] rev size+ <*> gFromColumns @restColumns rev size+ gReadingColumns =+ renderColumnName @(Column name chType)+ <> ", " <> gReadingColumns @restColumns @right++instance+ ( KnownColumn (Column name chType)+ , DeserializableColumn (Column name chType)+ , FromChType chType inputType+ , '(Column name chType, restColumns) ~ TakeColumn name columns+ ) => GReadable columns ((S1 (MetaSel (Just name) a b f)) (Rec0 inputType))+ where+ {-# INLINE gFromColumns #-}+ gFromColumns rev size = map (M1 . K1 . fromChType @chType) . columnValues <$> deserializeColumn @(Column name chType) rev size+ gReadingColumns = renderColumnName @(Column name chType)++-- ***++-- ** Raw columns deserialization++class DeserializableColumns columns where+ deserializeRawColumns :: ProtocolRevision -> UVarInt -> Get columns++instance+ DeserializableColumns (Columns '[])+ where+ {-# INLINE deserializeRawColumns #-}+ deserializeRawColumns _rev _rows = pure Empty++instance + ( KnownColumn (Column name chType)+ , DeserializableColumn (Column name chType)+ , DeserializableColumns (Columns extraColumns)+ )+ =>+ DeserializableColumns (Columns (Column name chType ': extraColumns))+ where+ {-# INLINE deserializeRawColumns #-}+ deserializeRawColumns rev rows =+ AddColumn+ <$> deserializeColumn rev rows+ <*> deserializeRawColumns @(Columns extraColumns) rev rows+++-- ** Column deserialization++{-# SPECIALIZE replicateM :: Int -> Get chType -> Get [chType] #-}++class DeserializableColumn column where+ deserializeColumn :: ProtocolRevision -> UVarInt -> Get column++instance+ ( KnownColumn (Column name chType)+ , Deserializable chType+ ) =>+ DeserializableColumn (Column name chType) where+ deserializeColumn rev rows = do+ _columnName <- deserialize @ChString rev+ _columnType <- deserialize @ChString rev+ _isCustom <- deserialize @(ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION) rev+ column <- replicateM (fromIntegral rows) (deserialize @chType rev)+ pure $ mkColumn @(Column name chType) rows column++instance {-# OVERLAPPING #-}+ ( KnownColumn (Column name (Nullable chType))+ , Deserializable chType+ ) =>+ DeserializableColumn (Column name (Nullable chType)) where+ deserializeColumn rev rows = do+ _columnName <- deserialize @ChString rev+ _columnType <- deserialize @ChString rev+ _isCustom <- deserialize @(ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION) rev+ nulls <- replicateM (fromIntegral rows) (deserialize @ChUInt8 rev)+ nullable <-+ forM+ nulls+ (\case+ 0 -> Just <$> deserialize @chType rev+ _ -> (Nothing <$ deserialize @chType rev)+ )+ pure $ mkColumn @(Column name (Nullable chType)) rows nullable++instance {-# OVERLAPPING #-}+ ( KnownColumn (Column name (LowCardinality chType))+ , Deserializable chType+ , ToChType (LowCardinality chType) chType+ , IsLowCardinalitySupported chType+ , TypeError ('Text "LowCardinality deserialization still unsupported")+ ) =>+ DeserializableColumn (Column name (LowCardinality chType)) where+ deserializeColumn rev rows = do+ _columnName <- deserialize @ChString rev+ _columnType <- deserialize @ChString rev+ _isCustom <- deserialize @(ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION) rev+ _serializationType <- (.&. 0xf) <$> deserialize @ChUInt64 rev+ _index_size <- deserialize @ChInt64 rev+ -- error $ "Trace | " <> show _serializationType <> " : " <> show _index_size+ lc <- replicateM (fromIntegral rows) (toChType <$> deserialize @chType rev)+ pure $ mkColumn @(Column name (LowCardinality chType)) rows lc++instance {-# OVERLAPPING #-}+ ( KnownColumn (Column name (ChArray chType))+ , Deserializable chType+ , TypeError ('Text "Arrays deserialization still unsupported")+ )+ => DeserializableColumn (Column name (ChArray chType)) where+ deserializeColumn rev rows = do+ _columnName <- deserialize @ChString rev+ _columnType <- deserialize @ChString rev+ _isCustom <- deserialize @(ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION) rev+ (arraySize, _offsets) <- traceShowId <$> readOffsets rev+ _types <- replicateM (fromIntegral arraySize) (deserialize @chType rev)+ pure $ mkColumn @(Column name (ChArray chType)) rows []+ where+ readOffsets :: ProtocolRevision -> Get (ChUInt64, [ChUInt64])+ readOffsets revivion = do+ size <- deserialize @ChUInt64 rev+ (size, ) <$> go size+ where+ go arraySize =+ do+ nextOffset <- deserialize @ChUInt64 revivion+ if arraySize >= nextOffset+ then pure [nextOffset]+ else (nextOffset :) <$> go arraySize++++-- ** Columns extraction helper++class+ HasColumns hasColumns+ where+ type GetColumns hasColumns :: [Type]++instance HasColumns (Columns columns)+ where+ type GetColumns (Columns columns) = columns+++-- ** Take column by name from list of columns++type family+ TakeColumn (name :: Symbol) (columns :: [Type]) :: (Type, [Type])+ where+ TakeColumn name columns = GoTakeColumn name columns '[]++type family+ GoTakeColumn name (columns :: [Type]) (acc :: [Type]) :: (Type, [Type])+ where+ GoTakeColumn name (Column name chType ': columns) acc = '(Column name chType, acc ++ columns)+ GoTakeColumn name (Column name1 chType ': columns) acc = (GoTakeColumn name columns (Column name1 chType ': acc))+ GoTakeColumn name '[] acc = TypeError+ ( 'Text "There is no column \"" :<>: 'Text name :<>: 'Text "\" in table"+ :$$: 'Text "You can't use this field"+ )++type family+ (++) (list1 :: [Type]) (list2 :: [Type]) :: [Type]+ where+ (++) '[] list = list+ (++) (head ': tail) list = tail ++ (head ': list)
+ ClickHaskell/DbTypes.hs view
@@ -0,0 +1,553 @@+{-# LANGUAGE+ GeneralizedNewtypeDeriving+ , LambdaCase+ , OverloadedStrings+#-}++module ClickHaskell.DbTypes+( IsChType(ToChTypeName, chTypeName, defaultValueOfTypeName)+, ToChType(toChType)+, FromChType(fromChType)+, ToQueryPart(toQueryPart)++, ChDateTime(..)+, ChDate(..)++, ChInt8(..), ChInt16(..), ChInt32(..), ChInt64(..), ChInt128(..)+, ChUInt8(..), ChUInt16(..), ChUInt32(..), ChUInt64(..), ChUInt128(..)++, ChString(..)+, ChUUID(..)++, ChArray(..)+, Nullable+, LowCardinality, IsLowCardinalitySupported++, UVarInt(..)+, module Data.WideWord+) where++-- Internal dependencies++-- External+import Data.WideWord (Int128 (..), Word128(..))++-- GHC included+import Control.DeepSeq (NFData)+import Data.Bits (Bits (..))+import Data.ByteString as BS (StrictByteString, toStrict)+import Data.ByteString.Builder as BS (Builder, byteString, toLazyByteString)+import Data.ByteString.Char8 as BS8 (concatMap, length, pack, replicate, singleton)+import Data.Coerce (coerce)+import Data.Int (Int16, Int32, Int64, Int8)+import Data.List (uncons)+import Data.String (IsString)+import Data.Text as Text (Text)+import Data.Text.Encoding as Text (encodeUtf8)+import Data.Time (UTCTime, ZonedTime, zonedTimeToUTC)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)+import Data.Typeable (Proxy (..))+import Data.Vector.Primitive.Mutable (Prim)+import Data.Word (Word16, Word32, Word64, Word8)+import GHC.Generics+import GHC.TypeLits (AppendSymbol, ErrorMessage (..), KnownSymbol, Symbol, TypeError, symbolVal)+++class+ KnownSymbol (ToChTypeName chType) =>+ IsChType chType+ where+ -- | Shows database original type name+ --+ -- @+ -- type ToChTypeName ChString = \"String\"+ -- type ToChTypeName (Nullable ChUInt32) = \"Nullable(UInt32)\"+ -- @+ type ToChTypeName chType :: Symbol++ chTypeName :: Builder+ chTypeName = byteString . BS8.pack . symbolVal @(ToChTypeName chType) $ Proxy++ defaultValueOfTypeName :: chType++class IsChType chType => ToChType chType inputType where toChType :: inputType -> chType+class IsChType chType => FromChType chType outputType where fromChType :: chType -> outputType+class IsChType chType => ToQueryPart chType where toQueryPart :: chType -> BS.Builder++instance {-# OVERLAPPABLE #-} (IsChType chType, chType ~ inputType) => ToChType chType inputType where toChType = id+instance {-# OVERLAPPABLE #-} (IsChType chType, chType ~ inputType) => FromChType chType inputType where fromChType = id++++-- | ClickHouse Nullable(T) column type+-- (type synonym for Maybe)+type Nullable = Maybe++type NullableTypeName chType = "Nullable(" `AppendSymbol` ToChTypeName chType `AppendSymbol` ")"++{-+This instance leads to disable -Wmissing-methods+Need to move it's semantics to another instances++instance {-# OVERLAPPING #-}+ ( TypeError+ ( 'Text (ToChTypeName (Nullable (LowCardinality chType))) ':<>: 'Text " is unsupported type in ClickHouse."+ ':$$: 'Text "Use " ':<>: 'Text (ToChTypeName (LowCardinality (Nullable chType))) ':<>: 'Text " instead."+ )+ , IsChType chType+ ) => IsChType (Nullable (LowCardinality chType))+ where+ defaultValueOfTypeName = error "Unreachable"+ chTypeName = error "Unreachable"+-}++instance+ ( IsChType chType+ , KnownSymbol ("Nullable(" `AppendSymbol` ToChTypeName chType `AppendSymbol` ")")+ )+ =>+ IsChType (Nullable chType)+ where+ type ToChTypeName (Nullable chType) = NullableTypeName chType+ defaultValueOfTypeName = Nothing++instance+ ( ToQueryPart chType+ , IsChType (Nullable chType)+ )+ =>+ ToQueryPart (Nullable chType)+ where+ toQueryPart = maybe "null" toQueryPart++instance+ ( ToChType inputType chType+ , IsChType (Nullable inputType)+ )+ =>+ ToChType (Nullable inputType) (Nullable chType)+ where+ toChType = fmap (toChType @inputType @chType)++instance+ ( FromChType chType inputType+ , IsChType (Nullable chType)+ )+ =>+ FromChType (Nullable chType) (Nullable inputType)+ where+ fromChType = fmap (fromChType @chType)+++++-- | ClickHouse LowCardinality(T) column type+newtype LowCardinality chType = MkLowCardinality chType+deriving newtype instance (Eq chType, IsLowCardinalitySupported chType) => Eq (LowCardinality chType)+deriving newtype instance (Show chType, IsLowCardinalitySupported chType) => Show (LowCardinality chType)+deriving newtype instance (NFData chType, IsLowCardinalitySupported chType) => NFData (LowCardinality chType)+deriving newtype instance IsString (LowCardinality ChString)++class IsChType chType => IsLowCardinalitySupported chType+instance IsLowCardinalitySupported ChString+instance+ ( IsLowCardinalitySupported chType+ , IsChType (Nullable chType)+ ) =>+ IsLowCardinalitySupported (Nullable chType)++instance {-# OVERLAPPABLE #-}+ ( IsChType chType+ , TypeError+ ( 'Text "LowCardinality(" ':<>: 'ShowType chType ':<>: 'Text ") is unsupported"+ ':$$: 'Text "Use one of these types:"+ ':$$: 'Text " ChString"+ ':$$: 'Text " ChDateTime"+ ':$$: 'Text " Nullable(T)"+ )+ ) => IsLowCardinalitySupported chType++instance+ ( IsLowCardinalitySupported chType+ , KnownSymbol ("LowCardinality(" `AppendSymbol` ToChTypeName chType `AppendSymbol` ")")+ ) =>+ IsChType (LowCardinality chType)+ where+ type ToChTypeName (LowCardinality chType) = "LowCardinality(" `AppendSymbol` ToChTypeName chType `AppendSymbol` ")"+ defaultValueOfTypeName = MkLowCardinality $ defaultValueOfTypeName @chType++instance+ ( ToChType inputType chType+ , IsChType (LowCardinality inputType)+ , IsLowCardinalitySupported inputType+ )+ =>+ ToChType (LowCardinality inputType) chType+ where+ toChType = MkLowCardinality . toChType++instance {-# OVERLAPPING #-}+ ( IsChType (LowCardinality chType)+ , IsLowCardinalitySupported chType+ )+ =>+ ToChType (LowCardinality chType) chType+ where+ toChType = MkLowCardinality++instance IsLowCardinalitySupported chType => ToChType chType (LowCardinality chType)+ where+ toChType (MkLowCardinality value) = value++instance IsLowCardinalitySupported chType => FromChType chType (LowCardinality chType)+ where+ fromChType = MkLowCardinality++instance+ ( FromChType chType outputType+ , IsChType (LowCardinality chType)+ , IsLowCardinalitySupported chType+ )+ =>+ FromChType (LowCardinality chType) outputType+ where+ fromChType (MkLowCardinality value) = fromChType value++instance {-# OVERLAPPING #-}+ ( IsChType (LowCardinality chType)+ , IsLowCardinalitySupported chType+ )+ =>+ FromChType (LowCardinality chType) chType+ where+ fromChType (MkLowCardinality value) = value++instance+ ( ToQueryPart chType+ , IsChType (LowCardinality chType)+ , IsLowCardinalitySupported chType+ )+ =>+ ToQueryPart (LowCardinality chType)+ where+ toQueryPart (MkLowCardinality chType) = toQueryPart chType+++++-- | ClickHouse UUID column type+newtype ChUUID = MkChUUID Word128+ deriving newtype (Generic, Show, Eq, NFData, Bounded, Prim, Enum)++instance IsChType ChUUID where+ type ToChTypeName ChUUID = "UUID"+ defaultValueOfTypeName = MkChUUID 0+++instance ToChType ChUUID Word64 where toChType = MkChUUID . flip Word128 0+instance ToChType ChUUID (Word64, Word64) where toChType = MkChUUID . uncurry (flip Word128)++instance FromChType ChUUID (Word64, Word64) where fromChType (MkChUUID (Word128 w64hi w64lo)) = (w64hi, w64lo)+++++-- | ClickHouse String column type+newtype ChString = MkChString StrictByteString+ deriving newtype (Show, Eq, IsString, NFData)++instance IsChType ChString where+ type ToChTypeName ChString = "String"+ defaultValueOfTypeName = ""+++instance ToQueryPart ChString where toQueryPart (MkChString string) = "'" <> escapeQuery string <> "'"++escapeQuery :: StrictByteString -> Builder+escapeQuery -- [ClickHaskell.DbTypes.ToDo.1]: Optimize+ = BS.byteString+ . BS8.concatMap (\case '\'' -> "\\\'"; '\\' -> "\\\\"; sym -> BS8.singleton sym;)++instance ToChType ChString StrictByteString where toChType = MkChString+instance ToChType ChString Builder where toChType = MkChString . toStrict . toLazyByteString+instance ToChType ChString String where toChType = MkChString . BS8.pack+instance ToChType ChString Text where toChType = MkChString . Text.encodeUtf8+instance ToChType ChString Int where toChType = MkChString . BS8.pack . show++instance FromChType ChString StrictByteString where fromChType (MkChString string) = string+instance+ ( TypeError+ ( 'Text "ChString to Text using FromChType convertion could cause exception"+ ':$$: 'Text "Decode ByteString manually if you are sure it's always can be decoded or replace it with ByteString"+ )+ ) =>+ FromChType ChString Text+ where+ fromChType = error "Unreachable"+++++-- | ClickHouse Int8 column type+newtype ChInt8 = MkChInt8 Int8+ deriving newtype (Show, Eq, Num, Prim, Bits, Enum, Ord, Real, Integral, Bounded, NFData)++instance IsChType ChInt8 where+ type ToChTypeName ChInt8 = "Int8"+ defaultValueOfTypeName = 0++instance ToQueryPart ChInt8+ where+ toQueryPart = BS.byteString . BS8.pack . show++instance ToChType ChInt8 Int8 where toChType = MkChInt8++instance FromChType ChInt8 Int8 where fromChType = coerce+++++-- | ClickHouse Int16 column type+newtype ChInt16 = MkChInt16 Int16+ deriving newtype (Show, Eq, Num, Prim, Bits, Enum, Ord, Real, Integral, Bounded, NFData)++instance IsChType ChInt16 where+ type ToChTypeName ChInt16 = "Int16"+ defaultValueOfTypeName = 0++instance ToQueryPart ChInt16 where toQueryPart = BS.byteString . BS8.pack . show++instance ToChType ChInt16 Int16 where toChType = MkChInt16++instance FromChType ChInt16 Int16 where fromChType (MkChInt16 int16) = int16+++++-- | ClickHouse Int32 column type+newtype ChInt32 = MkChInt32 Int32+ deriving newtype (Show, Eq, Num, Prim, Bits, Enum, Ord, Real, Integral, Bounded, NFData)++instance IsChType ChInt32 where+ type ToChTypeName ChInt32 = "Int32"+ defaultValueOfTypeName = 0++instance ToQueryPart ChInt32 where toQueryPart = BS.byteString . BS8.pack . show++instance ToChType ChInt32 Int32 where toChType = MkChInt32++instance FromChType ChInt32 Int32 where fromChType (MkChInt32 int32) = int32+++++-- | ClickHouse Int64 column type+newtype ChInt64 = MkChInt64 Int64+ deriving newtype (Show, Eq, Num, Prim, Bits, Enum, Ord, Real, Integral, Bounded, NFData)++instance IsChType ChInt64 where+ type ToChTypeName ChInt64 = "Int64"+ defaultValueOfTypeName = 0++instance ToQueryPart ChInt64 where toQueryPart = BS.byteString . BS8.pack . show++instance ToChType ChInt64 Int64 where toChType = MkChInt64 . fromIntegral+instance ToChType ChInt64 Int where toChType = MkChInt64 . fromIntegral++instance FromChType ChInt64 Int64 where fromChType = coerce+++++-- | ClickHouse Int128 column type+newtype ChInt128 = MkChInt128 Int128+ deriving newtype (Show, Eq, Num, Prim, Bits, Ord, Real, Enum, Integral, Bounded, NFData)++instance IsChType ChInt128 where+ type ToChTypeName ChInt128 = "Int128"+ defaultValueOfTypeName = 0++instance ToQueryPart ChInt128 where toQueryPart = BS.byteString . BS8.pack . show++instance ToChType ChInt128 Int128 where toChType = MkChInt128 . fromIntegral++instance FromChType ChInt128 Int128 where fromChType (MkChInt128 int128) = int128+++++-- | ClickHouse UInt8 column type+newtype ChUInt8 = MkChUInt8 Word8+ deriving newtype (Show, Eq, Num, Prim, Bits, Enum, Ord, Real, Integral, Bounded, NFData)++instance IsChType ChUInt8 where+ type ToChTypeName ChUInt8 = "UInt8"+ defaultValueOfTypeName = 0+++instance ToQueryPart ChUInt8 where toQueryPart = BS.byteString . BS8.pack . show++instance ToChType ChUInt8 Word8 where toChType = MkChUInt8++instance FromChType ChUInt8 Word8 where fromChType (MkChUInt8 w8) = w8+++++-- | ClickHouse UInt16 column type+newtype ChUInt16 = MkChUInt16 Word16+ deriving newtype (Show, Eq, Num, Prim, Bits, Enum, Ord, Real, Integral, Bounded, NFData)++instance IsChType ChUInt16 where+ type ToChTypeName ChUInt16 = "UInt16"+ defaultValueOfTypeName = 0++instance ToQueryPart ChUInt16 where toQueryPart = BS.byteString . BS8.pack . show++instance ToChType ChUInt16 Word16 where toChType = coerce++instance FromChType ChUInt16 Word16 where fromChType = coerce+++++-- | ClickHouse UInt32 column type+newtype ChUInt32 = MkChUInt32 Word32+ deriving newtype (Show, Eq, Num, Prim, Bits, Enum, Ord, Real, Integral, Bounded, NFData)++instance IsChType ChUInt32 where+ type ToChTypeName ChUInt32 = "UInt32"+ defaultValueOfTypeName = 0++instance ToQueryPart ChUInt32 where toQueryPart = BS.byteString . BS8.pack . show++instance ToChType ChUInt32 Word32 where toChType = MkChUInt32++instance FromChType ChUInt32 Word32 where fromChType (MkChUInt32 word32) = word32+++++-- | ClickHouse UInt64 column type+newtype ChUInt64 = MkChUInt64 Word64+ deriving newtype (Show, Eq, Num, Prim, Bits, Enum, Ord, Real, Integral, Bounded, NFData)++instance IsChType ChUInt64 where+ type ToChTypeName ChUInt64 = "UInt64"+ defaultValueOfTypeName = 0++instance ToQueryPart ChUInt64 where toQueryPart = BS.byteString . BS8.pack . show++instance ToChType ChUInt64 Word64 where toChType = MkChUInt64++instance FromChType ChUInt64 Word64 where fromChType (MkChUInt64 w64) = w64+++++-- | ClickHouse UInt128 column type+newtype ChUInt128 = MkChUInt128 Word128+ deriving newtype (Show, Eq, Num, Prim, Bits, Enum, Ord, Real, Integral, Bounded, NFData)++instance IsChType ChUInt128 where+ type ToChTypeName ChUInt128 = "UInt128"+ defaultValueOfTypeName = 0++instance ToQueryPart ChUInt128 where toQueryPart = BS.byteString . BS8.pack . show++instance ToChType ChUInt128 Word128 where toChType = MkChUInt128+instance ToChType ChUInt128 Word64 where toChType = MkChUInt128 . fromIntegral++instance FromChType ChUInt128 Word128 where fromChType (MkChUInt128 w128) = w128+++++-- | ClickHouse DateTime column type+newtype ChDateTime = MkChDateTime Word32+ deriving newtype (Show, Eq, Prim, Num, Bits, Enum, Ord, Real, Integral, Bounded, NFData)++instance IsChType ChDateTime+ where+ type ToChTypeName ChDateTime = "DateTime"+ defaultValueOfTypeName = MkChDateTime 0++instance ToQueryPart ChDateTime+ where+ toQueryPart chDateTime = let time = BS8.pack . show . fromChType @ChDateTime @Word32 $ chDateTime+ in BS.byteString (BS8.replicate (10 - BS8.length time) '0' <> time)++instance ToChType ChDateTime Word32 where toChType = MkChDateTime+instance ToChType ChDateTime UTCTime where toChType = MkChDateTime . floor . utcTimeToPOSIXSeconds+instance ToChType ChDateTime ZonedTime where toChType = MkChDateTime . floor . utcTimeToPOSIXSeconds . zonedTimeToUTC++instance FromChType ChDateTime Word32 where fromChType = coerce+instance FromChType ChDateTime UTCTime where fromChType (MkChDateTime w32) = posixSecondsToUTCTime (fromIntegral w32)+++++newtype ChDate = MkChDate Word16+ deriving newtype (Show, Eq, Prim, Bits, Bounded, Enum, NFData)++instance IsChType ChDate where+ type ToChTypeName ChDate = "Date"+ defaultValueOfTypeName = MkChDate 0++instance ToChType ChDate Word16 where toChType = MkChDate++instance FromChType ChDate Word16 where fromChType = coerce+++++newtype ChArray a = MkChArray [a]+ deriving newtype (Show, Eq, NFData)++instance+ ( IsChType chType+ , KnownSymbol (AppendSymbol (AppendSymbol "Array(" (ToChTypeName chType)) ")")+ ) =>+ IsChType (ChArray chType)+ where+ type ToChTypeName (ChArray chType) = "Array(" `AppendSymbol` ToChTypeName chType `AppendSymbol` ")"+ defaultValueOfTypeName = MkChArray []+++++instance+ ( ToQueryPart chType+ , IsChType (ChArray chType)+ ) =>+ ToQueryPart (ChArray chType)+ where+ toQueryPart+ = (\x -> "[" <> x <> "]")+ . (maybe "" (uncurry (foldr (\ a b -> a <> "," <> b)))+ . uncons+ . map (toQueryPart @chType))+ . fromChType++instance+ ( IsChType chType+ , IsChType (ChArray chType)+ ) =>+ FromChType (ChArray chType) [chType] where fromChType (MkChArray values) = values++instance+ ( ToChType chType inputType+ , IsChType (ChArray chType)+ ) =>+ ToChType (ChArray chType) [inputType] where toChType = MkChArray . map toChType+++++{- |+ Unsigned variable-length quantity encoding+ + Part of protocol implementation+-}+newtype UVarInt = MkUVarInt Word64+ deriving newtype (Show, Eq, Num, Prim, Bits, Enum, Ord, Real, Integral, Bounded, NFData)
+ ClickHaskell/DeSerialization.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE OverloadedStrings #-}++module ClickHaskell.DeSerialization where++-- Internal dependencies+import ClickHaskell.Versioning (ProtocolRevision(..), SinceRevision (..), afterRevision)+import ClickHaskell.DbTypes++-- GHC included+import Data.Binary.Get+import Data.Binary.Get.Internal (readN)+import Data.Binary.Put+import Data.Bits (Bits (..))+import Data.ByteString as BS (length, take)+import Data.ByteString.Builder (Builder, word8)+import Data.Coerce (coerce)+import Data.Typeable (Proxy (..))+import GHC.Generics+import GHC.TypeLits (KnownNat, natVal)++-- * Deserialization++class+ Deserializable chType+ where+ default deserialize :: (Generic chType, GDeserializable (Rep chType)) => ProtocolRevision -> Get chType+ deserialize :: ProtocolRevision -> Get chType+ deserialize rev = to <$> gDeserialize rev+++-- ** Generics++class GDeserializable f+ where+ gDeserialize :: ProtocolRevision -> Get (f p)++instance+ GDeserializable f+ =>+ GDeserializable (D1 c (C1 c2 f))+ where+ {-# INLINE gDeserialize #-}+ gDeserialize rev = M1 . M1 <$> gDeserialize rev++instance+ GDeserializable (left :*: (right1 :*: right2))+ =>+ GDeserializable ((left :*: right1) :*: right2)+ where+ {-# INLINE gDeserialize #-}+ gDeserialize rev = (\(l :*: (r1 :*: r2)) -> (l :*: r1) :*: r2) <$> gDeserialize rev++instance+ (GDeserializable (S1 metaSel field), GDeserializable right)+ =>+ GDeserializable (S1 metaSel field :*: right)+ where+ {-# INLINE gDeserialize #-}+ gDeserialize rev = (:*:) <$> gDeserialize rev <*> gDeserialize rev++instance+ Deserializable chType+ =>+ GDeserializable (S1 (MetaSel (Just typeName) a b f) (Rec0 chType))+ where+ {-# INLINE gDeserialize #-}+ gDeserialize rev = M1 . K1 <$> deserialize @chType rev+++-- ** Versioning++instance+ ( KnownNat revision+ , Deserializable chType+ )+ =>+ Deserializable (SinceRevision chType revision)+ where+ deserialize rev =+ if rev >= (fromIntegral . natVal) (Proxy @revision)+ then MkSinceRevision <$> deserialize @chType rev+ else pure NotPresented++instance Deserializable ProtocolRevision where+ deserialize rev = coerce <$> deserialize @UVarInt rev+++-- ** Database types++instance Deserializable ChUUID where+ deserialize _ = MkChUUID <$> (flip Word128 <$> getWord64le <*> getWord64le)++instance Deserializable ChString where+ deserialize rev = do+ strSize <- fromIntegral <$> deserialize @UVarInt rev+ toChType <$> readN strSize (BS.take strSize)+++instance Deserializable ChInt8 where deserialize _ = toChType <$> getInt8+instance Deserializable ChInt16 where deserialize _ = toChType <$> getInt16le+instance Deserializable ChInt32 where deserialize _ = toChType <$> getInt32le+instance Deserializable ChInt64 where deserialize _ = toChType <$> getInt64le+instance Deserializable ChInt128 where deserialize _ = toChType <$> (flip Int128 <$> getWord64le <*> getWord64le)+instance Deserializable ChUInt8 where deserialize _ = toChType <$> getWord8+instance Deserializable ChUInt16 where deserialize _ = toChType <$> getWord16le+instance Deserializable ChUInt32 where deserialize _ = toChType <$> getWord32le+instance Deserializable ChUInt64 where deserialize _ = toChType <$> getWord64le+instance Deserializable ChUInt128 where deserialize _ = toChType <$> (flip Word128 <$> getWord64le <*> getWord64le)+instance Deserializable ChDateTime where deserialize _ = toChType <$> getWord32le+instance Deserializable ChDate where deserialize _ = toChType <$> getWord16le++instance Deserializable UVarInt where+ deserialize _ = go 0 (0 :: UVarInt)+ where+ go i o | i < 10 = do+ byte <- getWord8+ let o' = o .|. ((fromIntegral byte .&. 0x7f) `unsafeShiftL` (7 * i))+ if byte .&. 0x80 == 0 then pure $! o' else go (i + 1) $! o'+ go _ _ = fail "input exceeds varuint size"+++++++-- * Serialization++class Serializable chType+ where+ default serialize :: (Generic chType, GSerializable (Rep chType)) => ProtocolRevision -> chType -> Builder+ serialize :: ProtocolRevision -> chType -> Builder+ serialize rev = gSerialize rev . from+++-- ** Versioning++instance+ ( KnownNat revision+ , Serializable chType+ )+ =>+ Serializable (SinceRevision chType revision)+ where+ serialize rev (MkSinceRevision val) = afterRevision @revision rev (serialize rev val)+ serialize rev NotPresented = afterRevision @revision rev (error "Unexpected error")++instance Serializable ProtocolRevision where+ serialize rev = serialize @UVarInt rev . coerce+++-- ** Database types+instance Serializable UVarInt where+ serialize _ = go+ where+ go i+ | i < 0x80 = word8 (fromIntegral i)+ | otherwise = word8 (setBit (fromIntegral i) 7) <> go (unsafeShiftR i 7)++instance Serializable ChString where+ serialize rev str+ = (serialize @UVarInt rev . fromIntegral . BS.length . fromChType) str+ <> (execPut . putByteString . fromChType) str++instance Serializable ChUUID where serialize _ = execPut . (\(hi, lo) -> putWord64le lo <> putWord64le hi) . fromChType+instance Serializable ChInt8 where serialize _ = execPut . putInt8 . fromChType+instance Serializable ChInt16 where serialize _ = execPut . putInt16le . fromChType+instance Serializable ChInt32 where serialize _ = execPut . putInt32le . fromChType+instance Serializable ChInt64 where serialize _ = execPut . putInt64le . fromChType+instance Serializable ChInt128 where serialize _ = execPut . (\(Int128 hi lo) -> putWord64le lo <> putWord64le hi) . fromChType+instance Serializable ChUInt8 where serialize _ = execPut . putWord8 . fromChType+instance Serializable ChUInt16 where serialize _ = execPut . putWord16le . fromChType+instance Serializable ChUInt32 where serialize _ = execPut . putWord32le . fromChType+instance Serializable ChUInt64 where serialize _ = execPut . putWord64le . fromChType+instance Serializable ChUInt128 where serialize _ = execPut . (\(Word128 hi lo) -> putWord64le lo <> putWord64le hi) . fromChType+instance Serializable ChDateTime where serialize _ = execPut . putWord32le . fromChType+instance Serializable ChDate where serialize _ = execPut . putWord16le . fromChType+++++-- ** Generics++class GSerializable f+ where+ gSerialize :: ProtocolRevision -> f p -> Builder++instance+ GSerializable f+ =>+ GSerializable (D1 c (C1 c2 f))+ where+ {-# INLINE gSerialize #-}+ gSerialize rev (M1 (M1 re)) = gSerialize rev re++instance+ GSerializable (left1 :*: (left2 :*: right))+ =>+ GSerializable ((left1 :*: left2) :*: right)+ where+ {-# INLINE gSerialize #-}+ gSerialize rev ((l1 :*: l2) :*: r) = gSerialize rev (l1 :*: (l2 :*: r))++instance+ Serializable chType+ =>+ GSerializable (S1 (MetaSel (Just typeName) a b f) (Rec0 chType))+ where+ {-# INLINE gSerialize #-}+ gSerialize rev = serialize rev . unK1 . unM1++instance+ (Serializable chType, GSerializable right)+ =>+ GSerializable (S1 (MetaSel (Just typeName) a b f) (Rec0 chType) :*: right)+ where+ {-# INLINE gSerialize #-}+ gSerialize rev (left :*: right)+ = (serialize rev . unK1 . unM1 $ left) <> gSerialize rev right
+ ClickHaskell/NativeProtocol.hs view
@@ -0,0 +1,443 @@+{-# 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 = mostRecentRevision++-- * Client packets++data ClientPacketType+ = Hello+ | Query+ | Data+ | Cancel+ | Ping+ | TablesStatusRequest+ | KeepAlive+ | Scalar+ | IgnoredPartUUIDs+ | ReadTaskResponse+ | MergeTreeReadTaskResponse+ | SSHChallengeRequest+ | SSHChallengeResponse+ deriving (Enum, 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 _ = show . toEnum @ClientPacketType . fromIntegral $ packetNumVal @packetType++packetNumVal :: forall packetType . KnownNat (PacketTypeNumber packetType) => UVarInt+packetNumVal = fromIntegral . natVal $ Proxy @(PacketTypeNumber packetType)++instance+ KnownNat (PacketTypeNumber packetType)+ =>+ Serializable (Packet (packetType :: ClientPacketType)) where+ serialize rev _ = serialize @UVarInt rev (packetNumVal @packetType)++instance Deserializable (Packet (packetType :: ClientPacketType)) where+ deserialize _rev = pure (MkPacket @packetType)+++-- ** Hello++data HelloParameters = MkHelloParameters+ { chDatabase :: Text+ , chLogin :: Text+ , chPass :: Text+ }++mkHelloPacket :: HelloParameters -> HelloPacket+mkHelloPacket MkHelloParameters{chDatabase, chLogin, chPass} =+ MkHelloPacket+ { packet_type = MkPacket+ , client_name = clientNameAndVersion+ , client_version_major = clientMajorVersion+ , client_version_minor = clientMinorVersion+ , tcp_protocol_version = latestSupportedRevision+ , default_database = toChType chDatabase+ , user = toChType chLogin+ , password = toChType chPass+ }++data HelloPacket = MkHelloPacket+ { packet_type :: Packet Hello+ , client_name :: ChString+ , client_version_major :: UVarInt+ , client_version_minor :: UVarInt+ , tcp_protocol_version :: ProtocolRevision+ , default_database :: ChString+ , user :: ChString+ , password :: ChString+ }+ deriving (Generic, Serializable)+++mkAddendum :: Addendum+mkAddendum = MkAddendum+ { quota_key = MkSinceRevision ""+ }++data Addendum = MkAddendum+ { quota_key :: ChString `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_QUOTA_KEY+ }+ deriving (Generic, Serializable)+++-- ** Ping++mkPingPacket :: PingPacket+mkPingPacket = MkPingPacket{packet_type = MkPacket}++data PingPacket = MkPingPacket{packet_type :: Packet Ping}+ deriving (Generic, Serializable)+++-- ** Query++mkQueryPacket :: ProtocolRevision -> ChString -> ChString -> QueryPacket+mkQueryPacket chosenRev user query = MkQueryPacket+ { query_packet = MkPacket+ , query_id = ""+ , client_info = MkSinceRevision MkClientInfo+ { query_kind = InitialQuery+ , initial_user = user+ , initial_query_id = ""+ , initial_adress = "0.0.0.0:0"+ , initial_time = MkSinceRevision 0+ , interface_type = 1 -- [tcp - 1, http - 2]+ , os_user = "dmitry"+ , hostname = "desktop"+ , client_name = clientNameAndVersion+ , client_major = clientMajorVersion+ , client_minor = clientMinorVersion+ , client_revision = chosenRev+ , quota_key = MkSinceRevision ""+ , distrubuted_depth = MkSinceRevision 0+ , client_patch = MkSinceRevision clientPatchVersion+ , open_telemetry = MkSinceRevision 0+ , collaborate_with_initiator = MkSinceRevision 0+ , count_participating_replicas = MkSinceRevision 0+ , number_of_current_replica = MkSinceRevision 0+ }+ , settings = MkDbSettings+ , interserver_secret = MkSinceRevision ""+ , query_stage = Complete+ , compression = 0+ , query = query+ , parameters = MkSinceRevision MkQueryParameters+ }++data QueryPacket = MkQueryPacket+ { query_packet :: Packet Query+ , query_id :: ChString+ , client_info :: ClientInfo `SinceRevision` DBMS_MIN_REVISION_WITH_CLIENT_INFO+ , settings :: DbSettings+ , interserver_secret :: ChString `SinceRevision` DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET+ , query_stage :: QueryStage+ , compression :: UVarInt+ , query :: ChString+ , parameters :: QueryParameters `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS+ }+ deriving (Generic, Serializable)++data DbSettings = MkDbSettings+instance Serializable DbSettings where serialize rev _ = serialize @ChString rev ""++data QueryParameters = MkQueryParameters+instance Serializable QueryParameters where serialize rev _ = serialize @ChString rev ""++data QueryStage+ = FetchColumns+ | WithMergeableState+ | Complete+ | WithMergeableStateAfterAggregation+ | WithMergeableStateAfterAggregationAndLimit+ deriving (Enum)++instance Serializable QueryStage where+ serialize rev = serialize @UVarInt rev . fromIntegral . fromEnum++queryStageCode :: QueryStage -> UVarInt+queryStageCode = fromIntegral . fromEnum++data Flags = IMPORTANT | CUSTOM | OBSOLETE+flagCode :: Flags -> ChUInt64+flagCode IMPORTANT = 0x01+flagCode CUSTOM = 0x02+flagCode OBSOLETE = 0x04++data ClientInfo = MkClientInfo+ { query_kind :: QueryKind+ , initial_user :: ChString+ , initial_query_id :: ChString+ , initial_adress :: ChString+ , initial_time :: ChInt64 `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME+ , interface_type :: ChUInt8+ , os_user :: ChString+ , hostname :: ChString+ , client_name :: ChString+ , client_major :: UVarInt+ , client_minor :: UVarInt+ , client_revision :: ProtocolRevision+ , quota_key :: ChString `SinceRevision` DBMS_MIN_REVISION_WITH_QUOTA_KEY_IN_CLIENT_INFO+ , distrubuted_depth :: UVarInt `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_DISTRIBUTED_DEPTH+ , client_patch :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_VERSION_PATCH+ , open_telemetry :: ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_OPENTELEMETRY+ , collaborate_with_initiator :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS+ , count_participating_replicas :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS+ , number_of_current_replica :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS+ }+ deriving (Generic, Serializable)++data QueryKind = NoQuery | InitialQuery | SecondaryQuery+ deriving (Enum)++instance Serializable QueryKind where+ serialize rev = serialize @ChUInt8 rev . fromIntegral . fromEnum+++-- ** Data++mkDataPacket :: ChString -> UVarInt -> UVarInt -> DataPacket+mkDataPacket table_name columns_count rows_count =+ MkDataPacket+ { packet_type = MkPacket+ , table_name+ , block_info = MkBlockInfo+ { field_num1 = 1, is_overflows = 0+ , field_num2 = 2, bucket_num = -1+ , eof = 0+ }+ , columns_count+ , rows_count+ }++data DataPacket = MkDataPacket+ { packet_type :: Packet Data+ , table_name :: ChString+ , block_info :: BlockInfo+ , columns_count :: UVarInt+ , rows_count :: UVarInt+ }+ deriving (Generic, Serializable, Deserializable, Show)++data BlockInfo = MkBlockInfo+ { field_num1 :: UVarInt, is_overflows :: ChUInt8+ , field_num2 :: UVarInt, bucket_num :: ChInt32+ , eof :: UVarInt+ }+ deriving (Generic, Serializable, Deserializable, 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 rev = do+ packetNum <- deserialize @UVarInt rev+ case packetNum of+ 0 -> HelloResponse <$> deserialize rev+ 1 -> DataResponse <$> deserialize rev+ 2 -> Exception <$> deserialize rev+ 3 -> Progress <$> deserialize rev+ 4 -> pure Pong+ 5 -> pure EndOfStream+ 6 -> ProfileInfo <$> deserialize rev+ 7 -> pure Totals+ 8 -> pure Extremes+ 9 -> pure TablesStatusResponse+ 10 -> pure Log+ 11 -> TableColumns <$> deserialize rev+ 12 -> pure UUIDs+ 13 -> pure ReadTaskRequest+ 14 -> pure ProfileEvents+ _ -> pure $ UnknownPacket packetNum++instance Show ServerPacketType where+ show (HelloResponse hello) = "HelloResponse " <> show hello+ show (DataResponse dataPacket) = "DataResponse " <> show dataPacket+ show (Exception exception) = "Exception " <> show exception+ show (Progress progress) = "Progress " <> show progress+ show Pong = "Pong"+ show EndOfStream = "EndOfStream"+ show (ProfileInfo profileInfo) = "ProfileInfo " <> show profileInfo + show Totals = "Totals"+ show Extremes = "Extremes"+ show TablesStatusResponse = "TablesStatusResponse"+ show Log = "Log"+ show (TableColumns tabelColumnsPacket) = "TableColumns " <> show tabelColumnsPacket+ show UUIDs = "UUIDs"+ show ReadTaskRequest = "ReadTaskRequest"+ show ProfileEvents = "ProfileEvents"+ show (UnknownPacket packetNum) = "UnknownPacket: " <> show packetNum++-- ** HelloResponse++{-+ https://github.com/ClickHouse/ClickHouse/blob/eb4a74d7412a1fcf52727cd8b00b365d6b9ed86c/src/Client/Connection.cpp#L520+-}+data HelloResponse = MkHelloResponse+ { server_name :: ChString+ , server_version_major :: UVarInt+ , server_version_minor :: UVarInt+ , server_revision :: ProtocolRevision+ , server_parallel_replicas_proto :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL+ , server_timezone :: ChString `SinceRevision` DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE+ , server_display_name :: ChString `SinceRevision` DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME+ , server_version_patch :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_VERSION_PATCH+ , proto_send_chunked_srv :: ChString `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS+ , proto_recv_chunked_srv :: ChString `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS+ , password_complexity_rules :: [PasswordComplexityRules] `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES+ , read_nonce :: ChUInt64 `SinceRevision` DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2+ }+ deriving (Generic, Show)++instance Deserializable HelloResponse where+ deserialize revision = do+ server_name <- deserialize revision+ server_version_major <- deserialize revision+ server_version_minor <- deserialize revision+ server_revision <- deserialize revision+ -- Override current protocol revision for backward compatibility+ let chosenRevision = min server_revision revision+ server_parallel_replicas_proto <- deserialize chosenRevision+ server_timezone <- deserialize chosenRevision+ server_display_name <- deserialize chosenRevision+ server_version_patch <- deserialize chosenRevision+ proto_send_chunked_srv <- deserialize chosenRevision+ proto_recv_chunked_srv <- deserialize chosenRevision+ password_complexity_rules <- deserialize chosenRevision+ read_nonce <- deserialize chosenRevision+ pure MkHelloResponse{..}++data PasswordComplexityRules = MkPasswordComplexityRules+ { original_pattern :: ChString+ , exception_message :: ChString+ }+ deriving (Generic, Deserializable, Show)++instance Deserializable [PasswordComplexityRules] where+ deserialize rev = do+ len <- deserialize @UVarInt rev+ replicateM (fromIntegral len) (deserialize @PasswordComplexityRules rev)++-- ** Exception++data ExceptionPacket = MkExceptionPacket+ { code :: ChInt32+ , name :: ChString+ , message :: ChString+ , stack_trace :: ChString+ , nested :: ChUInt8+ }+ deriving (Generic, Deserializable, Show)++-- ** Progress++data ProgressPacket = MkProgressPacket+ { rows :: UVarInt+ , bytes :: UVarInt+ , total_rows :: UVarInt+ , total_bytes :: UVarInt `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_TOTAL_BYTES_IN_PROGRESS+ , wrote_rows :: UVarInt `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_TOTAL_BYTES_IN_PROGRESS+ , wrote_bytes :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_CLIENT_WRITE_INFO+ , elapsed_ns :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_CLIENT_WRITE_INFO+ }+ deriving (Generic, Deserializable, Show)++-- ** ProfileInfo++data ProfileInfo = MkProfileInfo+ { rows :: UVarInt+ , blocks :: UVarInt+ , bytes :: UVarInt+ , applied_limit :: ChUInt8+ , rows_before_limit :: UVarInt+ , calculated_rows_before_limit :: ChUInt8+ , applied_aggregation :: ChUInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_ROWS_BEFORE_AGGREGATION+ , rows_before_aggregation :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_ROWS_BEFORE_AGGREGATION+ }+ deriving (Generic, Deserializable, Show)++-- ** TableColumns++data TableColumns = MkTableColumns+ { table_name :: ChString+ , table_columns :: ChString+ }+ deriving (Generic, Deserializable, Show)+++++-- * Versioning++clientMajorVersion, clientMinorVersion, clientPatchVersion :: UVarInt+clientMajorVersion = case versionBranch version of (x:_) -> fromIntegral x; _ -> 0+clientMinorVersion = case versionBranch version of (_:x:_) -> fromIntegral x; _ -> 0+clientPatchVersion = case versionBranch version of (_:_:x:_) -> fromIntegral x; _ -> 0++clientNameAndVersion :: ChString+clientNameAndVersion = fromString $+ "ClickHaskell-"+ <> show clientMajorVersion <> "."+ <> show clientMinorVersion <> "."+ <> show clientPatchVersion <> "."
+ ClickHaskell/Parameters.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE+ OverloadedStrings+ , TypeFamilyDependencies+ , UndecidableInstances+#-}++module ClickHaskell.Parameters where++-- Internal+import ClickHaskell.DbTypes (ToQueryPart(..), ToChType(..))++-- GHC included+import Data.ByteString.Builder as BS (Builder, byteString)+import Data.ByteString.Char8 as BS8 (pack)+import Data.Data (Proxy (Proxy))+import Data.Kind (Type, Constraint)+import GHC.TypeLits (TypeError, ErrorMessage (..), Symbol, KnownSymbol, symbolVal)+import Data.Type.Bool (If)+import Data.Type.Equality (type(==))++data Parameter (name :: Symbol) (chType :: Type)++-- |+-- >>> parameters (parameter @"a3" @ChString ("a3Val" :: String) . parameter @"a2" @ChString ("a2Val" :: String))+-- "(a2='a2Val', a3='a3Val')"+parameters :: forall (params :: [Type]) . (Parameters '[] -> Parameters params) -> Builder+parameters interpreter = renderParameters $ interpreter (MkParametersInterpreter [])++parameter+ :: forall name chType parameters userType+ . (InterpretableParameters parameters, ToChType chType userType, KnownSymbol name, ToQueryPart chType)+ => userType -> Parameters parameters -> WithPassedParameter (Parameter name chType) parameters+parameter = interpretParameter . toChType++renderParameters :: Parameters parameters -> Builder+renderParameters (MkParametersInterpreter (param:ps)) = "(" <> foldr (\p1 p2 -> p1 <> ", " <> p2) param ps <> ")"+renderParameters (MkParametersInterpreter []) = ""+++{-# DEPRECATED ParametersInterpreter "This type would be removed in next major release. Use Parameters instead" #-}+type ParametersInterpreter a = Parameters a++newtype Parameters (parameters :: [Type]) =+ MkParametersInterpreter+ { evaluatedParameters :: [Builder]+ }++class InterpretableParameters (ps :: [Type]) where+ type WithPassedParameter p ps = withPassedParameter | withPassedParameter -> ps p+ interpretParameter+ :: forall name chType+ . (KnownSymbol name, ToQueryPart chType)+ => chType -> (Parameters ps -> WithPassedParameter (Parameter name chType) ps)++instance InterpretableParameters '[]+ where+ type WithPassedParameter p '[] = Parameters '[p]+ interpretParameter+ :: forall name chType+ . (KnownSymbol name, ToQueryPart chType)+ => chType -> Parameters '[] -> WithPassedParameter (Parameter name chType) '[]+ interpretParameter userType _ = MkParametersInterpreter [renderParameter @name @chType userType]++instance InterpretableParameters (x ': xs)+ where+ type WithPassedParameter p (x ': xs) = Parameters (p ': (x ': xs))+ interpretParameter+ :: forall name chType+ . (KnownSymbol name, ToQueryPart chType)+ => chType -> Parameters (x : xs) -> WithPassedParameter (Parameter name chType) (x : xs)+ interpretParameter chType (MkParametersInterpreter{evaluatedParameters}) =+ MkParametersInterpreter $ renderParameter @name @chType chType : evaluatedParameters++renderParameter :: forall name chType . (KnownSymbol name, ToQueryPart chType) => chType -> Builder+renderParameter chType = (BS.byteString . BS8.pack . symbolVal @name) Proxy <> "=" <> toQueryPart chType++type family CheckParameters+ (tableFunctionParams :: [Type])+ (passedParams :: [Type])+ :: Constraint+ where+ CheckParameters tfs ps = (CheckDuplicates ps, GoCheckParameters tfs ps '[] True)++type family CheckDuplicates+ (passedParams :: [Type])+ :: Constraint+ where+ CheckDuplicates '[] = ()+ CheckDuplicates (p ': ps) = (CheckParamDuplicates p ps, CheckDuplicates ps)++type family CheckParamDuplicates+ (param :: Type)+ (passedParams :: [Type])+ :: Constraint+ where+ CheckParamDuplicates _ '[] = ()+ CheckParamDuplicates (Parameter name1 chType) (Parameter name2 _ ': ps) = If+ (name1 == name2)+ (TypeError ('Text "Duplicated parameter \"" :<>: 'Text name1 :<>: 'Text "\" in passed parameters"))+ (CheckParamDuplicates (Parameter name1 chType) ps)++type family GoCheckParameters+ (tableFunctionParams :: [Type])+ (passedParams :: [Type])+ (acc :: [Type])+ (firstRound :: Bool)+ :: Constraint+ where+ GoCheckParameters '[] '[] '[] _ = ()+ GoCheckParameters (Parameter name _ ': _) '[] '[] _ = TypeError+ ('Text "Missing \"" :<>: 'Text name :<>: 'Text "\" in passed parameters.")+ GoCheckParameters '[] (p ': _) _ _ =+ TypeError ('Text "More parameters passed than used in the view")+ GoCheckParameters '[] '[] (p ': _) _ =+ TypeError ('Text "More parameters passed than used in the view")+ GoCheckParameters (Parameter name1 _ ': ps) '[] (Parameter name2 _ ': ps') False =+ TypeError ('Text "Missing \"" :<>: 'Text name1 :<>: 'Text "\" in passed parameters")+ GoCheckParameters (p ': ps) '[] (p' ': ps') True =+ GoCheckParameters (p ': ps) (p' ': ps') '[] False+ GoCheckParameters (Parameter name1 _ ': ps) (Parameter name1 _ ': ps') acc b =+ (GoCheckParameters ps ps' acc True)+ GoCheckParameters (Parameter name1 chType1 ': ps) (Parameter name2 chType2 ': ps') acc b =+ (GoCheckParameters (Parameter name1 chType1 ': ps) ps' (Parameter name2 chType2 ': acc) b)
+ ClickHaskell/Versioning.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module ClickHaskell.Versioning where++-- GHC included+import Data.Typeable (Proxy (..))+import GHC.TypeLits+import Data.Word (Word64)++newtype ProtocolRevision = MkProtocolRevision Word64+ deriving newtype (Show, Eq, Num, Ord)++{-# INLINE [0] afterRevision #-}+afterRevision+ :: forall revision monoid+ . (KnownNat revision, Monoid monoid)+ => ProtocolRevision -> monoid -> monoid+afterRevision chosenRevision monoid =+ if chosenRevision >= (fromIntegral . natVal) (Proxy @revision)+ then monoid+ else mempty++{-# INLINE [0] mostRecentRevision #-}+mostRecentRevision :: ProtocolRevision+mostRecentRevision = (fromIntegral . natVal) (Proxy @DBMS_TCP_PROTOCOL_VERSION)++data SinceRevision a (revisionNumber :: Nat) = MkSinceRevision a | NotPresented+instance Show a => Show (SinceRevision a revisionNumber) where+ show (MkSinceRevision a) = show a+ show NotPresented = ""++-- ** Versions++{-+ Slightly modified C++ sources:+ https://github.com/ClickHouse/ClickHouse/blob/eb4a74d7412a1fcf52727cd8b00b365d6b9ed86c/src/Core/ProtocolDefines.h#L6+-}+type DBMS_TCP_PROTOCOL_VERSION = 54448;++type DBMS_MIN_REVISION_WITH_CLIENT_INFO = 54032;+type DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE = 54058;+type DBMS_MIN_REVISION_WITH_QUOTA_KEY_IN_CLIENT_INFO = 54060;+type DBMS_MIN_REVISION_WITH_TABLES_STATUS = 54226;+type DBMS_MIN_REVISION_WITH_TIME_ZONE_PARAMETER_IN_DATETIME_DATA_TYPE = 54337;+type DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME = 54372;+type DBMS_MIN_REVISION_WITH_VERSION_PATCH = 54401;+type DBMS_MIN_REVISION_WITH_SERVER_LOGS = 54406;+type DBMS_MIN_REVISION_WITH_CURRENT_AGGREGATION_VARIANT_SELECTION_METHOD = 54448;+type DBMS_MIN_MAJOR_VERSION_WITH_CURRENT_AGGREGATION_VARIANT_SELECTION_METHOD = 21;+type DBMS_MIN_MINOR_VERSION_WITH_CURRENT_AGGREGATION_VARIANT_SELECTION_METHOD = 4;+type DBMS_MIN_REVISION_WITH_COLUMN_DEFAULTS_METADATA = 54410;+type DBMS_MIN_REVISION_WITH_LOW_CARDINALITY_TYPE = 54405;+type DBMS_MIN_REVISION_WITH_CLIENT_WRITE_INFO = 54420;+type DBMS_MIN_REVISION_WITH_SETTINGS_SERIALIZED_AS_STRINGS = 54429;+type DBMS_MIN_REVISION_WITH_SCALARS = 54429;+type DBMS_MIN_REVISION_WITH_OPENTELEMETRY = 54442;+type DBMS_MIN_REVISION_WITH_AGGREGATE_FUNCTIONS_VERSIONING = 54452;+type DBMS_CLUSTER_PROCESSING_PROTOCOL_VERSION = 1;+type DBMS_MIN_SUPPORTED_PARALLEL_REPLICAS_PROTOCOL_VERSION = 3;+type DBMS_PARALLEL_REPLICAS_MIN_VERSION_WITH_MARK_SEGMENT_SIZE_FIELD = 4;+type DBMS_PARALLEL_REPLICAS_PROTOCOL_VERSION = 4;+type DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS = 54453;+type DBMS_MERGE_TREE_PART_INFO_VERSION = 1;+type DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET = 54441;+type DBMS_MIN_REVISION_WITH_X_FORWARDED_FOR_IN_CLIENT_INFO = 54443;+type DBMS_MIN_REVISION_WITH_REFERER_IN_CLIENT_INFO = 54447;+type DBMS_MIN_PROTOCOL_VERSION_WITH_DISTRIBUTED_DEPTH = 54448;+type DBMS_MIN_PROTOCOL_VERSION_WITH_INCREMENTAL_PROFILE_EVENTS = 54451;+type DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION = 54454;+type DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME = 54449;+type DBMS_MIN_PROTOCOL_VERSION_WITH_PROFILE_EVENTS_IN_INSERT = 54456;+type DBMS_MIN_PROTOCOL_VERSION_WITH_VIEW_IF_PERMITTED = 54457;+type DBMS_MIN_PROTOCOL_VERSION_WITH_ADDENDUM = 54458;+type DBMS_MIN_PROTOCOL_VERSION_WITH_QUOTA_KEY = 54458;+type DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS = 54459;+type DBMS_MIN_PROTOCOL_VERSION_WITH_SERVER_QUERY_TIME_IN_PROGRESS = 54460;+type DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES = 54461;+type DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2 = 54462;+type DBMS_MIN_PROTOCOL_VERSION_WITH_TOTAL_BYTES_IN_PROGRESS = 54463;+type DBMS_MIN_PROTOCOL_VERSION_WITH_TIMEZONE_UPDATES = 54464;+type DBMS_MIN_REVISION_WITH_SPARSE_SERIALIZATION = 54465;+type DBMS_MIN_REVISION_WITH_SSH_AUTHENTICATION = 54466;+type DBMS_MIN_REVISION_WITH_TABLE_READ_ONLY_CHECK = 54467;+type DBMS_MIN_REVISION_WITH_SYSTEM_KEYWORDS_TABLE = 54468;+type DBMS_MIN_REVISION_WITH_ROWS_BEFORE_AGGREGATION = 54469;+type DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS = 54470;+type DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL = 54471;
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2023, Kovalev Dmitry++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Kovalev Dmitry nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,6 @@+# Description++ClickHaskell is a Haskell implementation of\+[ClickHouse](https://clickhouse.com/) DBMS Native protocol and client++You can find more details on [documentation page](https://kovalevdima.github.io/ClickHaskell/)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain