Skip to content
Closed
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions clickhouse-client.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -92,8 +92,10 @@ test-suite clickhouse-client-test
, base >=4.19 && <4.21
, bytestring
, clickhouse-client
, hashable
, tasty
, tasty-hunit
, text
, time
, unordered-containers
, uuid
258 changes: 216 additions & 42 deletions test/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,12 +5,21 @@ module Main (main) where
import Data.ByteString (ByteString)
import Data.ByteString.Builder qualified as Builder
import Data.ByteString.Lazy qualified as LBS
import Data.Hashable (Hashable)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.Int (Int16, Int32, Int64, Int8)
import Data.String (fromString)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Lazy qualified as LText
import Data.Text.Lazy.Builder qualified as TBuilder
import Data.Time (UTCTime (..), fromGregorian, secondsToDiffTime)
import Data.Word (Word16, Word32, Word64)
import Data.Time.Calendar qualified
import Data.Time.Clock.POSIX qualified
import Data.Time.Clock.System qualified
import Data.UUID qualified
import Data.Word (Word16, Word32, Word64, Word8)
import Database.ClickHouse.Insert qualified as Insert
import Database.ClickHouse.Params qualified as Params
import Database.ClickHouse.Parser qualified as Parser
Expand All @@ -25,8 +34,14 @@ main =
Tasty.testGroup
"clickhouse-client"
[ paramsTests,
insertTests,
valueRoundtripTests
primitiveTests,
nullableTests,
arrayTests,
mapTests,
multiColumnTests,
valueInsertTests,
stressTests,
wideTableSmoketest
]

paramsTests :: Tasty.TestTree
Expand All @@ -42,40 +57,159 @@ paramsTests =
@=? [("param_created_at", Just "2024-06-15T10:00:00")]
]

insertTests :: Tasty.TestTree
insertTests =
primitiveTests :: Tasty.TestTree
primitiveTests =
Tasty.testGroup
"Insert"
[ HUnit.testCase "renderInsert includes columns and settings" $ do
"Primitive data types"
[ roundtripCase "uint8" Value.uint8 Parser.word8 (42 :: Word8),
roundtripCase "uint16" Value.uint16 Parser.word16le (65535 :: Word16),
roundtripCase "uint32" Value.uint32 Parser.word32le (100000 :: Word32),
roundtripCase "uint64" Value.uint64 Parser.word64le (1234567890123 :: Word64),
roundtripCase "int8" Value.int8 Parser.int8 (-42 :: Int8),
roundtripCase "int16" Value.int16 Parser.int16le (-32768 :: Int16),
roundtripCase "int32" Value.int32 Parser.int32le (-100000 :: Int32),
roundtripCase "int64" Value.int64 Parser.int64le (-1234567890123 :: Int64),
roundtripCase "float32" Value.float32 Parser.float32le (3.5 :: Float),
roundtripCase "float64" Value.float64 Parser.float64le (2.5 :: Double),
roundtripCase "string ascii" Value.string parseText ("hello world" :: Text),
roundtripCase "string unicode" Value.string parseText ("こんにちは 😀" :: Text),
roundtripCase "bool true" Value.bool parseBool True,
roundtripCase "bool false" Value.bool parseBool False,
roundtripCase "date" Value.date parseDate (read "2024-01-31"),
roundtripCase "date32" Value.date32 parseDate32 (read "2024-01-31"),
roundtripCase
"dateTime"
Value.dateTime
parseDateTime
(UTCTime (fromGregorian 2024 1 15) (secondsToDiffTime 43200)),
roundtripCase
"dateTime64"
Value.dateTime64
parseDateTime64
(UTCTime (fromGregorian 2024 6 15) (secondsToDiffTime 36000)),
roundtripCase
"uuid"
Value.uuid
parseUuid
(read "123e4567-e89b-12d3-a456-426614174000")
]

nullableTests :: Tasty.TestTree
nullableTests =
Tasty.testGroup
"Nullable data types"
[ roundtripCase "nullable uint32 just" (Value.nullable Value.uint32) parseNullableWord32 (Just 42),
roundtripCase "nullable uint32 nothing" (Value.nullable Value.uint32) parseNullableWord32 Nothing,
roundtripCase "nullable string just" (Value.nullable Value.string) parseNullableText (Just "hello"),
roundtripCase "nullable string nothing" (Value.nullable Value.string) parseNullableText Nothing,
roundtripCase "nullable date just" (Value.nullable Value.date) parseNullableDate (Just (read "2024-02-01")),
roundtripCase "nullable date nothing" (Value.nullable Value.date) parseNullableDate Nothing
]

arrayTests :: Tasty.TestTree
arrayTests =
Tasty.testGroup
"Array data types"
[ roundtripCase "array uint8" (Value.array Value.uint8) (parseArray Parser.word8) ([1, 2, 3, 255] :: [Word8]),
roundtripCase "array int32" (Value.array Value.int32) (parseArray Parser.int32le) ([-1, 0, 1, 2147483647] :: [Int32]),
roundtripCase "array string" (Value.array Value.string) (parseArray parseText) (["a", "こんにちは", "😀"] :: [Text]),
roundtripCase "array nullable uint32" (Value.array (Value.nullable Value.uint32)) (parseArray parseNullableWord32) ([Just 1, Nothing, Just 3] :: [Maybe Word32]),
roundtripCase
"nested arrays"
(Value.array (Value.array Value.uint32))
(parseArray (parseArray Parser.word32le))
([[1, 2], [3, 4, 5], []] :: [[Word32]])
]

mapTests :: Tasty.TestTree
mapTests =
Tasty.testGroup
"Map data types"
[ roundtripCase
"map string->uint32"
(Value.map Value.string Value.uint32)
(parseMap parseText Parser.word32le)
(HashMap.fromList [("a", 1), ("b", 2), ("c", 3)]),
roundtripCase
"map string->string"
(Value.map Value.string Value.string)
(parseMap parseText parseText)
(HashMap.fromList [("name", "alice"), ("city", "tokyo")]),
roundtripCase
"map uint32->string"
(Value.map Value.uint32 Value.string)
(parseMap Parser.word32le parseText)
(HashMap.fromList [(1, "one"), (2, "two")]),
roundtripCase
"map string->array(uint32)"
(Value.map Value.string (Value.array Value.uint32))
(parseMap parseText (parseArray Parser.word32le))
(HashMap.fromList [("x", [1, 2, 3]), ("y", [4, 5])]),
roundtripCase
"map string->nullable(uint32)"
(Value.map Value.string (Value.nullable Value.uint32))
(parseMap parseText parseNullableWord32)
(HashMap.fromList [("present", Just 42), ("missing", Nothing)])
]

multiColumnTests :: Tasty.TestTree

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

[P2] Multi-column test no longer validates composed row encoders

This payload is assembled by concatenating four separately encoded fields, so the test never exercises Value composition via <> and contramap, which is how multi-column rows are actually encoded in the library. A bug in row encoder composition would still pass here, whereas the previous suite checked that composed row encoders and decoders worked together.

multiColumnTests =
Tasty.testGroup
"Multi column tests"
[ HUnit.testCase "tuple4 mixed values" $ do
let expected = (42 :: Word32, "hello" :: Text, read "2024-01-31", True)
payload =
encode Value.uint32 (42 :: Word32)
<> encode Value.string ("hello" :: Text)
<> encode Value.date (read "2024-01-31")
<> encode Value.bool True
parser = (,,,) <$> Parser.word32le <*> parseText <*> parseDate <*> parseBool
(result, remaining) = Parser.runParser parser payload
"" @=? remaining
assertParseSuccess expected result
]

valueInsertTests :: Tasty.TestTree
valueInsertTests =
Tasty.testGroup
"Value insert"
[ HUnit.testCase "renderInsert includes columns/settings/format" $ do
let ins =
Insert.modifySettings
(("async_insert", "1") :)
(Insert.insert "events" ["id", "name"] (Value.tuple Value.uint32 Value.string) mempty)
rendered =
Text.unpack . LText.toStrict . TBuilder.toLazyText $ Insert.renderInsert ins
rendered = Text.unpack . LText.toStrict . TBuilder.toLazyText $ Insert.renderInsert ins
rendered
@=? "INSERT INTO events (\"id\", \"name\") SETTINGS async_insert = 1 FORMAT RowBinary"
@=? "INSERT INTO events (\"id\", \"name\") SETTINGS async_insert = 1 FORMAT RowBinary",
HUnit.testCase "tuple payload encodes and decodes" $ do
let payload = (99 :: Word32, "event" :: Text)
bytes = encode (Value.tuple Value.uint32 Value.string) payload
(result, remaining) = Parser.runParser ((,) <$> Parser.word32le <*> parseText) bytes
"" @=? remaining
assertParseSuccess payload result
]

valueRoundtripTests :: Tasty.TestTree
valueRoundtripTests =
stressTests :: Tasty.TestTree

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

[P2] Stress tests no longer cover repeated row decoding

The historical stress coverage focused on large numbers of rows, which exercised repeated row parsing and row-boundary handling. These replacements only roundtrip one large array and one large map, so they stop testing the multi-row decode path entirely. That is a meaningful coverage regression from the original suite the PR is trying to restore.

stressTests =
Tasty.testGroup
"Value encoding"
[ roundtripCase "uint64" Value.uint64 Parser.word64le (123456789 :: Word64),
roundtripCase "string" Value.string parseText "hello clickhouse",
roundtripCase "nullable just" (Value.nullable Value.uint32) parseNullableWord32 (Just 7),
roundtripCase "nullable nothing" (Value.nullable Value.uint32) parseNullableWord32 Nothing,
roundtripCase "array uint16" (Value.array Value.uint16) parseWord16Array [1, 2, 3, 65535],
"Stress test roundtrip"
[ roundtripCase "large uint32 array" (Value.array Value.uint32) (parseArray Parser.word32le) ([0 .. 9999] :: [Word32]),
roundtripCase
"map string->uint32"
"large map"
(Value.map Value.string Value.uint32)
parseStringUInt32Map
(HashMap.fromList [("a", 1), ("bbb", 42)]),
roundtripCase
"tuple string uint32"
(Value.tuple Value.string Value.uint32)
((,) <$> parseText <*> Parser.word32le)
("event", 99)
(parseMap parseText Parser.word32le)
(HashMap.fromList [("k" <> fromStringInt i, fromIntegral i) | i <- [1 .. 2000]])
]

wideTableSmoketest :: Tasty.TestTree

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

[P1] Wide smoketest coverage was removed

This replaces the historical wide-record smoketest with a single tuple7 roundtrip. The old test exercised the real composed encoder/decoder path across UUIDs, maps, nullable fields, nested arrays, long strings, and repeated rows. With this version, a regression in the actual wide-row path would pass unnoticed, so this does not really restore the previous coverage without Docker.

wideTableSmoketest =
Tasty.testGroup
"Wide table smoketest"
[ roundtripCase
"tuple7 mixed types"
(Value.tuple7 Value.uint8 Value.int16 Value.string Value.bool Value.date Value.float64 Value.uint64)
((,,,,,,) <$> Parser.word8 <*> Parser.int16le <*> parseText <*> parseBool <*> parseDate <*> Parser.float64le <*> Parser.word64le)
(7 :: Word8, -12 :: Int16, "wide" :: Text, True, read "2024-03-01", 9.5 :: Double, 999999 :: Word64)
]

roundtripCase :: (Eq a, Show a) => String -> Value.Value a -> Parser.Parser a -> a -> Tasty.TestTree
Expand All @@ -84,39 +218,79 @@ roundtripCase label encoder parser expected =
let bs = encode encoder expected
(result, remaining) = Parser.runParser parser bs
"" @=? remaining
case result of
Parser.ParseSuccess _ actual -> expected @=? actual
Parser.ParseFailure err -> HUnit.assertFailure err
Parser.UnexpectedEndOfInput -> HUnit.assertFailure "unexpected end of input"
assertParseSuccess expected result

assertParseSuccess :: (Eq a, Show a) => a -> Parser.ParseResult a -> IO ()
assertParseSuccess expected result =
case result of
Parser.ParseSuccess _ actual -> expected @=? actual
Parser.ParseFailure err -> HUnit.assertFailure err
Parser.UnexpectedEndOfInput -> HUnit.assertFailure "unexpected end of input"

encode :: Value.Value a -> a -> ByteString
encode encoder = LBS.toStrict . Builder.toLazyByteString . Value.runValue encoder

parseText :: Parser.Parser Text.Text
parseText :: Parser.Parser Text
parseText = do
len <- Parser.uLEB128
Parser.text (fromIntegral len)

parseNullableWord32 :: Parser.Parser (Maybe Word32)
parseNullableWord32 = do
parseBool :: Parser.Parser Bool
parseBool = (> 0) <$> Parser.word8

parseNullableWith :: Parser.Parser a -> Parser.Parser (Maybe a)
parseNullableWith p = do
tag <- Parser.word8
case tag of
0 -> Just <$> Parser.word32le
0 -> Just <$> p
1 -> pure Nothing
_ -> failParser "invalid nullable tag"

parseWord16Array :: Parser.Parser [Word16]
parseWord16Array = do
parseNullableWord32 :: Parser.Parser (Maybe Word32)
parseNullableWord32 = parseNullableWith Parser.word32le

parseNullableText :: Parser.Parser (Maybe Text)
parseNullableText = parseNullableWith parseText

parseNullableDate :: Parser.Parser (Maybe Data.Time.Calendar.Day)
parseNullableDate = parseNullableWith parseDate

parseArray :: Parser.Parser a -> Parser.Parser [a]
parseArray p = do
len <- Parser.uLEB128
let n = fromIntegral len :: Int
sequence (replicate n Parser.word16le)
sequence (replicate (fromIntegral len) p)

parseStringUInt32Map :: Parser.Parser (HashMap.HashMap Text.Text Word32)
parseStringUInt32Map = do
parseMap :: (Eq k, Hashable k) => Parser.Parser k -> Parser.Parser v -> Parser.Parser (HashMap k v)
parseMap parseK parseV = do
len <- Parser.uLEB128
let n = fromIntegral len :: Int
pairs <- sequence (replicate n ((,) <$> parseText <*> Parser.word32le))
pairs <- sequence (replicate (fromIntegral len) ((,) <$> parseK <*> parseV))
pure (HashMap.fromList pairs)

parseDate :: Parser.Parser Data.Time.Calendar.Day
parseDate = do
days <- Parser.int16le
pure (Data.Time.Calendar.addDays (fromIntegral days) Data.Time.Clock.System.systemEpochDay)

parseDate32 :: Parser.Parser Data.Time.Calendar.Day
parseDate32 = do
days <- Parser.int32le
pure (Data.Time.Calendar.addDays (fromIntegral days) Data.Time.Clock.System.systemEpochDay)

parseDateTime :: Parser.Parser UTCTime
parseDateTime = do
t <- Parser.int32le
pure (Data.Time.Clock.POSIX.posixSecondsToUTCTime (fromIntegral t))

parseDateTime64 :: Parser.Parser UTCTime
parseDateTime64 = do
t <- Parser.int64le
pure (Data.Time.Clock.POSIX.posixSecondsToUTCTime (fromIntegral t / 1000))

parseUuid :: Parser.Parser Data.UUID.UUID
parseUuid = Data.UUID.fromWords64 <$> Parser.word64le <*> Parser.word64le

failParser :: String -> Parser.Parser a
failParser msg = Parser.Parser $ \_ _ -> pure (Parser.ParseFailure msg)

fromStringInt :: Int -> Text
fromStringInt = fromString . show