clickhouse-haskell 0.1.2.2 → 0.1.2.3
raw patch · 9 files changed
+308/−252 lines, 9 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Database.ClickHouseDriver.Column: CKArray :: Vector ClickhouseType -> ClickhouseType
- Database.ClickHouseDriver.Column: CKDate :: !Integer -> !Int -> !Int -> ClickhouseType
- Database.ClickHouseDriver.Column: CKDecimal :: Float -> ClickhouseType
- Database.ClickHouseDriver.Column: CKDecimal128 :: Double -> ClickhouseType
- Database.ClickHouseDriver.Column: CKDecimal32 :: Float -> ClickhouseType
- Database.ClickHouseDriver.Column: CKDecimal64 :: Double -> ClickhouseType
- Database.ClickHouseDriver.Column: CKIPv4 :: (Word8, Word8, Word8, Word8) -> ClickhouseType
- Database.ClickHouseDriver.Column: CKIPv6 :: (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16) -> ClickhouseType
- Database.ClickHouseDriver.Column: CKInt128 :: Int64 -> Int64 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKInt16 :: Int16 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKInt32 :: Int32 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKInt64 :: Int64 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKInt8 :: Int8 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKNull :: ClickhouseType
- Database.ClickHouseDriver.Column: CKString :: ByteString -> ClickhouseType
- Database.ClickHouseDriver.Column: CKTuple :: Vector ClickhouseType -> ClickhouseType
- Database.ClickHouseDriver.Column: CKUInt128 :: Word64 -> Word64 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKUInt16 :: Word16 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKUInt32 :: Word32 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKUInt64 :: Word64 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKUInt8 :: Word8 -> ClickhouseType
- Database.ClickHouseDriver.Column: [day] :: ClickhouseType -> !Int
- Database.ClickHouseDriver.Column: [month] :: ClickhouseType -> !Int
- Database.ClickHouseDriver.Column: [year] :: ClickhouseType -> !Integer
- Database.ClickHouseDriver.Column: data ClickhouseType
+ Database.ClickHouseDriver.Column: c_convert_time :: Int64 -> CString -> Int -> IO CString
+ Database.ClickHouseDriver.Column: c_convert_time64 :: Float -> CString -> Int -> IO CString
+ Database.ClickHouseDriver.Column: c_write_time :: CString -> CString -> Int -> Int -> IO Int32
+ Database.ClickHouseDriver.Column: convert_time_from_int32 :: Int32 -> IO Int32
+ Database.ClickHouseDriver.Column: genSpecs :: ByteString -> [Vector Word64] -> Reader (ByteString, [Vector Word64])
+ Database.ClickHouseDriver.Column: getSpecs :: ByteString -> [ByteString]
+ Database.ClickHouseDriver.Column: hi_bits_128 :: Double -> Int -> Word64
+ Database.ClickHouseDriver.Column: hi_bits_negative_128 :: Double -> Int -> Word64
+ Database.ClickHouseDriver.Column: low_bits_128 :: Double -> Int -> Word64
+ Database.ClickHouseDriver.Column: low_bits_negative_128 :: Double -> Int -> Word64
+ Database.ClickHouseDriver.Column: readArray :: ServerInfo -> Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readArraySpec :: Vector Word64 -> Reader (Vector Word64)
+ Database.ClickHouseDriver.Column: readDate :: Int -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readDateTime :: ServerInfo -> Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readDateTimeWithSpec :: ServerInfo -> Int -> Maybe Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readDecimal :: Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readEnum :: Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readFixed :: Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readFixedLengthString :: Int -> Reader ClickhouseType
+ Database.ClickHouseDriver.Column: readIPv4 :: Int -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readIPv6 :: Int -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readIntColumn :: Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readLowCardinality :: ServerInfo -> Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readNullable :: ServerInfo -> Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readSimpleAggregateFunction :: ServerInfo -> Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readTimeSpec :: ByteString -> (Maybe Int, Maybe ByteString)
+ Database.ClickHouseDriver.Column: readTuple :: ServerInfo -> Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readUUID :: Int -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: typeMismatchError :: ByteString -> String
+ Database.ClickHouseDriver.Column: word128_division :: Word64 -> Word64 -> Int -> Double
+ Database.ClickHouseDriver.Column: writeArray :: Context -> ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeDate :: ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeDateTime :: ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeDecimal :: ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeEnum :: ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeFixedLengthString :: ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeIPv4 :: ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeIPv6 :: ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeIntColumn :: ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeLowCardinality :: Context -> ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeNullable :: Context -> ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeStringColumn :: ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeTuple :: Context -> ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeUIntColumn :: ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeUUID :: ByteString -> Vector ClickhouseType -> Writer Builder
Files
- clickhouse-haskell.cabal +6/−2
- src/Database/ClickHouseDriver/Block.hs +3/−2
- src/Database/ClickHouseDriver/Client.hs +2/−2
- src/Database/ClickHouseDriver/Column.hs +5/−13
- src/Database/ClickHouseDriver/Connection.hs +2/−1
- src/Database/ClickHouseDriver/HTTP/Client.hs +149/−101
- src/Database/ClickHouseDriver/HTTP/Connection.hs +67/−54
- src/Database/ClickHouseDriver/HTTP/Helpers.hs +51/−49
- src/Database/ClickHouseDriver/HTTP/Types.hs +23/−28
clickhouse-haskell.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: clickhouse-haskell-version: 0.1.2.2+version: 0.1.2.3 synopsis: A Haskell library as database client for Clickhouse homepage: https://github.com/2049foundation/clickhouse-haskell/ bug-reports: https://github.com/2049foundation/clickhouse-haskell/issues@@ -114,7 +114,11 @@ Paths_clickhouse_haskell hs-source-dirs: test- ghc-options: -threaded -rtsopts -with-rtsopts=-N+ ghc-options: + -threaded + -rtsopts + -with-rtsopts=-N+ -O2 build-depends: clickhouse-haskell, base >= 4.12 && <5,
src/Database/ClickHouseDriver/Block.hs view
@@ -26,7 +26,7 @@ where import Database.ClickHouseDriver.Column- ( ClickhouseType, readColumn, writeColumn )+ (readColumn, writeColumn ) import Database.ClickHouseDriver.Defines as Defines ( _DBMS_MIN_REVISION_WITH_BLOCK_INFO ) import Database.ClickHouseDriver.Types@@ -34,7 +34,8 @@ Block(..), BlockInfo(..), Context(Context),- ServerInfo(revision) )+ ServerInfo(revision),+ ClickhouseType ) import Database.ClickHouseDriver.IO.BufferedReader ( readBinaryInt32, readBinaryStr,
src/Database/ClickHouseDriver/Client.hs view
@@ -47,7 +47,6 @@ ) where -import Database.ClickHouseDriver.Column ( ClickhouseType ) import Database.ClickHouseDriver.Connection ( ping', tcpConnect,@@ -63,7 +62,8 @@ CKResult(CKResult, query_result), TCPConnection(TCPConnection, tcpSocket), getServerInfo,- defaultQueryInfo )+ defaultQueryInfo,+ ClickhouseType(..) ) import Database.ClickHouseDriver.IO.BufferedReader ( createBuffer ) import Control.Concurrent.Async ( mapConcurrently ) import Control.Exception ( SomeException, try )
src/Database/ClickHouseDriver/Column.hs view
@@ -7,17 +7,7 @@ -- | This module contains the implementations of -- serialization and deserialization of Clickhouse data types.-module Database.ClickHouseDriver.Column- ( -- * Serialize and deserialize- ClickhouseType (..),- readColumn,- writeColumn,-- -- * Operations on ClickhouseType- transpose,- Database.ClickHouseDriver.Column.putStrLn,- )-where+module Database.ClickHouseDriver.Column where import Database.ClickHouseDriver.Types (ClickhouseType (..), Context (..), ServerInfo (..)) import Database.ClickHouseDriver.IO.BufferedReader@@ -607,9 +597,11 @@ combine :: Vector ClickhouseType -> Vector Word64 -> Vector ClickhouseType combine elems config = let intervals = intervalize (fromIntegral <$> config)- cut (a, b) = CKArray $ V.take b (V.drop a elems) -- cut element array+ cut :: (Int, Int)->ClickhouseType+ cut (a, b) = CKArray $ V.take b (V.drop a elems) embed = (\(l, r) -> cut (l, r - l + 1)) <$> intervals- in embed+ in embed+ intervalize :: Vector Int -> Vector (Int, Int) intervalize vec = V.drop 1 $ V.scanl' (\(_, b) v -> (b + 1, v + b)) (-1, -1) vec -- drop the first tuple (-1,-1)
src/Database/ClickHouseDriver/Connection.hs view
@@ -32,7 +32,7 @@ import qualified Database.ClickHouseDriver.Block as Block import qualified Database.ClickHouseDriver.ClientProtocol as Client-import Database.ClickHouseDriver.Column (ClickhouseType, transpose)+import Database.ClickHouseDriver.Column (transpose) import Database.ClickHouseDriver.Defines ( _BUFFER_SIZE, _CLIENT_NAME,@@ -83,6 +83,7 @@ readProgress, storeProfile, storeProgress,+ ClickhouseType(..) ) import Database.ClickHouseDriver.IO.BufferedReader ( Buffer (socket),
src/Database/ClickHouseDriver/HTTP/Client.hs view
@@ -3,8 +3,9 @@ -- -- This source code is distributed under the terms of a MIT license, -- found in the LICENSE file.- {-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}@@ -12,16 +13,13 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE CPP #-} -- | This module provides implementation of user's API- module Database.ClickHouseDriver.HTTP.Client- ( - -- * Setting+ ( -- * Setting setupEnv, runQuery,+ -- * Query getByteString, getJSON,@@ -33,60 +31,75 @@ ping, exec, insertFromFile,+ -- * Connection defaultHttpClient, httpClient,- defaultHttpPool+ defaultHttpPool, ) where -import Database.ClickHouseDriver.Column ( ClickhouseType )+import Control.Concurrent.Async (mapConcurrently)+import Control.Exception (SomeException, try)+import Control.Monad.State.Lazy (MonadIO (..))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Data.ByteString.Lazy.Builder+ ( char8,+ lazyByteString,+ toLazyByteString,+ )+import qualified Data.ByteString.Lazy.Char8 as C8+import Data.Default.Class (def)+import Data.Hashable (Hashable (hashWithSalt))+import Data.Pool (Pool, withResource)+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8)+import Data.Time.Clock (NominalDiffTime)+import Data.Typeable (Typeable) import Database.ClickHouseDriver.Defines as Defines- ( _DEFAULT_HTTP_PORT, _DEFAULT_HOST )+ ( _DEFAULT_HOST,+ _DEFAULT_HTTP_PORT,+ ) import Database.ClickHouseDriver.HTTP.Connection- ( defaultHttpConnection,- createHttpPool, httpConnectDb)+ ( createHttpPool,+ defaultHttpConnection,+ httpConnectDb,+ ) import Database.ClickHouseDriver.HTTP.Helpers- ( extract, genURL, toString )-import Database.ClickHouseDriver.HTTP.Types ( Format(..), JSONResult, HttpConnection(..))-import Control.Concurrent.Async ( mapConcurrently )-import Control.Exception ( SomeException, try )-import Control.Monad.State.Lazy ( MonadIO(..) )-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as LBS-import Data.ByteString.Lazy.Builder (char8, lazyByteString,- toLazyByteString)-import qualified Data.ByteString.Lazy.Char8 as C8-import Data.Hashable ( Hashable(hashWithSalt) )-import qualified Data.Text as T-import Data.Text.Encoding ( decodeUtf8 )-import Data.Typeable ( Typeable )+ ( extract,+ genURL,+ toString,+ )+import Database.ClickHouseDriver.HTTP.Types (Format (..), HttpConnection (..), JSONResult)+import Database.ClickHouseDriver.Types (ClickhouseType) import Haxl.Core- ( putFailure,- putSuccess,- dataFetch,- initEnv,- runHaxl,- stateEmpty,- stateSet,- BlockedFetch(..),- DataSource(fetch),- DataSourceName(..),- PerformFetch(SyncFetch),- Env(userEnv),- GenHaxl,- ShowP(..),- StateKey(State) )-import Network.HTTP.Client (RequestBody (..),- httpLbs, method,- parseRequest,- requestBody,- responseBody,- streamFile)-import Text.Printf ( printf )-import Data.Pool ( withResource, Pool )-import Data.Time.Clock ( NominalDiffTime ) -import Data.Default.Class (def)+ ( BlockedFetch (..),+ DataSource (fetch),+ DataSourceName (..),+ Env (userEnv),+ GenHaxl,+ PerformFetch (SyncFetch),+ ShowP (..),+ StateKey (State),+ dataFetch,+ initEnv,+ putFailure,+ putSuccess,+ runHaxl,+ stateEmpty,+ stateSet,+ )+import Network.HTTP.Client+ ( RequestBody (..),+ httpLbs,+ method,+ parseRequest,+ requestBody,+ responseBody,+ streamFile,+ )+import Text.Printf (printf) {-Implementation in Haxl-} --@@ -109,7 +122,7 @@ hashWithSalt salt (FetchByteString cmd) = hashWithSalt salt cmd hashWithSalt salt (FetchJSON cmd) = hashWithSalt salt cmd hashWithSalt salt (FetchCSV cmd) = hashWithSalt salt cmd- hashWithSalt salt Ping = hashWithSalt salt ("ok"::BS.ByteString)+ hashWithSalt salt Ping = hashWithSalt salt ("ok" :: BS.ByteString) instance DataSourceName HttpClient where dataSourceName _ = "ClickhouseDataSource"@@ -122,12 +135,13 @@ [()] -> return () instance StateKey HttpClient where- data State HttpClient = SingleHttp HttpConnection- | HttpPool (Pool HttpConnection)+ data State HttpClient+ = SingleHttp HttpConnection+ | HttpPool (Pool HttpConnection) class HttpEnvironment a where- toEnv :: a->State HttpClient- pick :: a-> IO HttpConnection+ toEnv :: a -> State HttpClient+ pick :: a -> IO HttpConnection instance HttpEnvironment HttpConnection where toEnv = SingleHttp@@ -155,8 +169,8 @@ req <- parseRequest url ans <- responseBody <$> httpLbs req mng return $ LBS.toStrict ans- HttpPool pool -> - withResource pool $ \conn@(HttpConnection _ mng)->do+ HttpPool pool ->+ withResource pool $ \conn@(HttpConnection _ mng) -> do url <- genURL conn queryWithType req <- parseRequest url ans <- responseBody <$> httpLbs req mng@@ -165,7 +179,7 @@ (putFailure var) (putSuccess var) (e :: Either SomeException (BS.ByteString))- + -- | Fetch data from ClickHouse client in the text format. getByteString :: String -> GenHaxl u w BS.ByteString getByteString = dataFetch . FetchByteString@@ -181,77 +195,111 @@ getTextM :: (Monad m, Traversable m) => m String -> GenHaxl u w (m T.Text) getTextM = mapM getText --- | Fetch data from Clickhouse client in the format of JSON +-- | Fetch data from Clickhouse client in the format of JSON getJsonM :: (Monad m, Traversable m) => m String -> GenHaxl u w (m JSONResult) getJsonM = mapM getJSON -- | actual function used by user to perform fetching command-exec :: (HttpEnvironment a)=>String->Env a w->IO (Either C8.ByteString String)+exec :: (HttpEnvironment a) => String -> Env a w -> IO (Either C8.ByteString String) exec cmd' env = do let cmd = C8.pack cmd'- conn@HttpConnection{httpManager=mng} <- pick $ userEnv env+ conn@HttpConnection {httpManager = mng} <- pick $ userEnv env url <- genURL conn "" req <- parseRequest url- ans <- responseBody <$> httpLbs req{ method = "POST"- , requestBody = RequestBodyLBS cmd} mng+ ans <-+ responseBody+ <$> httpLbs+ req+ { method = "POST",+ requestBody = RequestBodyLBS cmd+ }+ mng if ans /= "" then return $ Left ans -- error message else return $ Right "Created successfully" -- | insert one row-insertOneRow :: (HttpEnvironment a)=> String- -> [ClickhouseType]- -> Env a w- -> IO (Either C8.ByteString String)+insertOneRow ::+ (HttpEnvironment a) =>+ String ->+ [ClickhouseType] ->+ Env a w ->+ IO (Either C8.ByteString String) insertOneRow table_name arr environment = do let row = toString arr let cmd = C8.pack ("INSERT INTO " ++ table_name ++ " VALUES " ++ row)- settings@HttpConnection{httpManager=mng} <- pick $ userEnv environment+ settings@HttpConnection {httpManager = mng} <- pick $ userEnv environment url <- genURL settings "" req <- parseRequest url- ans <- responseBody <$> httpLbs req{ method = "POST"- , requestBody = RequestBodyLBS cmd} mng+ ans <-+ responseBody+ <$> httpLbs+ req+ { method = "POST",+ requestBody = RequestBodyLBS cmd+ }+ mng if ans /= "" then return $ Left ans -- error messagethe hellenic republic else return $ Right "Inserted successfully" --- | insert one or more rows -insertMany :: (HttpEnvironment a)=> String- -> [[ClickhouseType]]- -> Env a w- -> IO(Either C8.ByteString String)+-- | insert one or more rows+insertMany ::+ (HttpEnvironment a) =>+ String ->+ [[ClickhouseType]] ->+ Env a w ->+ IO (Either C8.ByteString String) insertMany table_name rows environment = do let rowsString = map (lazyByteString . C8.pack . toString) rows- comma = char8 ','+ comma = char8 ',' preset = lazyByteString $ C8.pack $ "INSERT INTO " <> table_name <> " VALUES "- togo = preset <> (foldl1 (\x y-> x <> comma <> y) rowsString)- settings@HttpConnection{httpManager=mng} <- pick $ userEnv environment+ togo = preset <> (foldl1 (\x y -> x <> comma <> y) rowsString)+ settings@HttpConnection {httpManager = mng} <- pick $ userEnv environment url <- genURL settings "" req <- parseRequest url- ans <- responseBody <$> httpLbs req{method = "POST"- , requestBody = RequestBodyLBS $ toLazyByteString togo} mng+ ans <-+ responseBody+ <$> httpLbs+ req+ { method = "POST",+ requestBody = RequestBodyLBS $ toLazyByteString togo+ }+ mng print "inserted successfully" if ans /= "" then return $ Left ans else return $ Right "Successful insertion" --- | insert data from -insertFromFile :: (HttpEnvironment a)=> String- ->Format- ->FilePath- ->Env a w- ->IO(Either C8.ByteString String)+-- | insert data from+insertFromFile ::+ (HttpEnvironment a) =>+ String ->+ Format ->+ FilePath ->+ Env a w ->+ IO (Either C8.ByteString String) insertFromFile table_name format file environment = do fileReqBody <- streamFile file- settings@HttpConnection{httpManager=mng} <- pick $ userEnv environment- url <- genURL settings ("INSERT INTO " <> table_name - <> case format of- CSV->" FORMAT CSV"- JSON->" FORMAT JSON"- TUPLE->" VALUES")+ settings@HttpConnection {httpManager = mng} <- pick $ userEnv environment+ url <-+ genURL+ settings+ ( "INSERT INTO " <> table_name+ <> case format of+ CSV -> " FORMAT CSV"+ JSON -> " FORMAT JSON"+ TUPLE -> " VALUES"+ ) req <- parseRequest url- ans <- responseBody <$> httpLbs req {method = "POST"- , requestBody = fileReqBody} mng+ ans <-+ responseBody+ <$> httpLbs+ req+ { method = "POST",+ requestBody = fileReqBody+ }+ mng if ans /= "" then return $ Left ans -- error message else return $ Right "Inserted successfully"@@ -260,20 +308,20 @@ ping = dataFetch $ Ping -- | Default environment-setupEnv :: (MonadIO m, HttpEnvironment a)=>a->m (Env a w)+setupEnv :: (MonadIO m, HttpEnvironment a) => a -> m (Env a w) setupEnv csetting = liftIO $ initEnv (stateSet (toEnv csetting) stateEmpty) csetting -defaultHttpClient :: (MonadIO m)=>m (Env HttpConnection w)+defaultHttpClient :: (MonadIO m) => m (Env HttpConnection w) defaultHttpClient = liftIO $ defaultHttpConnection >>= setupEnv -defaultHttpPool :: (MonadIO m)=>Int->NominalDiffTime->Int->m(Env (Pool HttpConnection) w)-defaultHttpPool numStripes idleTime maxResources - = liftIO $ createHttpPool def numStripes idleTime maxResources >>= setupEnv+defaultHttpPool :: (MonadIO m) => Int -> NominalDiffTime -> Int -> m (Env (Pool HttpConnection) w)+defaultHttpPool numStripes idleTime maxResources =+ liftIO $ createHttpPool def numStripes idleTime maxResources >>= setupEnv -httpClient :: (MonadIO m)=> String->String-> m(Env HttpConnection w)+httpClient :: (MonadIO m) => String -> String -> m (Env HttpConnection w) httpClient user password = liftIO $ httpConnectDb user password Defines._DEFAULT_HTTP_PORT Defines._DEFAULT_HOST Nothing >>= setupEnv -- | rename runHaxl function. {-# INLINE runQuery #-}-runQuery :: (MonadIO m)=> Env u w -> GenHaxl u w a -> m a+runQuery :: (MonadIO m) => Env u w -> GenHaxl u w a -> m a runQuery env haxl = liftIO $ runHaxl env haxl
src/Database/ClickHouseDriver/HTTP/Connection.hs view
@@ -3,29 +3,37 @@ -- -- This source code is distributed under the terms of a MIT license, -- found in the LICENSE file.--{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- | Connection pool for HTTP connection. User should import Database.ClickHouseDriver.HTTP instead--module Database.ClickHouseDriver.HTTP.Connection (- httpConnect,+module Database.ClickHouseDriver.HTTP.Connection+ ( httpConnect, httpConnectDb, defaultHttpConnection,- HttpConnection(..),- createHttpPool-) where- -import Network.HTTP.Client- ( defaultManagerSettings, newManager)+ HttpConnection (..),+ createHttpPool,+ )+where++import Data.Default.Class (Default (..))+import Data.Pool (Pool, createPool)+import Data.Time.Clock (NominalDiffTime) import Database.ClickHouseDriver.HTTP.Types- ( HttpConnection(..),- HttpParams(HttpParams, httpUsername, httpPort, httpPassword,- httpHost, httpDatabase) ) -import Data.Default.Class ( Default(..) )-import Data.Pool ( createPool, Pool )-import Data.Time.Clock ( NominalDiffTime )+ ( HttpConnection (..),+ HttpParams+ ( HttpParams,+ httpDatabase,+ httpHost,+ httpPassword,+ httpPort,+ httpUsername+ ),+ )+import Network.HTTP.Client+ ( defaultManagerSettings,+ newManager,+ ) #define DEFAULT_USERNAME "default" #define DEFAULT_HOST_NAME "localhost"@@ -36,46 +44,51 @@ defaultHttpConnection = httpConnect DEFAULT_USERNAME DEFAULT_PASSWORD 8123 DEFAULT_HOST_NAME instance Default HttpParams where- def = HttpParams{- httpHost = DEFAULT_HOST_NAME,- httpPassword = DEFAULT_PASSWORD,- httpPort = 8123,- httpUsername = DEFAULT_USERNAME,- httpDatabase = Nothing- }--createHttpPool :: HttpParams- ->Int- ->NominalDiffTime- ->Int- ->IO(Pool HttpConnection)-createHttpPool HttpParams{- httpHost=host,- httpPassword = password,- httpPort = port,- httpUsername = user,- httpDatabase = db- } - = createPool(- do- httpConnectDb user password port host db- )(\_->return ())+ def =+ HttpParams+ { httpHost = DEFAULT_HOST_NAME,+ httpPassword = DEFAULT_PASSWORD,+ httpPort = 8123,+ httpUsername = DEFAULT_USERNAME,+ httpDatabase = Nothing+ } +createHttpPool ::+ HttpParams ->+ Int ->+ NominalDiffTime ->+ Int ->+ IO (Pool HttpConnection)+createHttpPool+ HttpParams+ { httpHost = host,+ httpPassword = password,+ httpPort = port,+ httpUsername = user,+ httpDatabase = db+ } =+ createPool+ ( do+ httpConnectDb user password port host db+ )+ (\_ -> return ()) -httpConnect :: String->String->Int->String->IO(HttpConnection)-httpConnect user password port host = +httpConnect :: String -> String -> Int -> String -> IO (HttpConnection)+httpConnect user password port host = httpConnectDb user password port host Nothing -httpConnectDb :: String->String->Int->String->Maybe String->IO(HttpConnection)+httpConnectDb :: String -> String -> Int -> String -> Maybe String -> IO (HttpConnection) httpConnectDb user password port host database = do mng <- newManager defaultManagerSettings- return HttpConnection {- httpParams = HttpParams {- httpHost = host,- httpPassword = password,- httpPort = port,- httpUsername = user,- httpDatabase = database- },- httpManager = mng- }+ return+ HttpConnection+ { httpParams =+ HttpParams+ { httpHost = host,+ httpPassword = password,+ httpPort = port,+ httpUsername = user,+ httpDatabase = database+ },+ httpManager = mng+ }
src/Database/ClickHouseDriver/HTTP/Helpers.hs view
@@ -3,41 +3,41 @@ -- -- This source code is distributed under the terms of a MIT license, -- found in the LICENSE file.- {-# LANGUAGE FlexibleInstances #-} --- | Miscellaneous helper functions. User should not import it. -+-- | Miscellaneous helper functions. User should not import it. module Database.ClickHouseDriver.HTTP.Helpers ( extract, genURL,- toString+ toString, ) where -import Database.ClickHouseDriver.Column- ( ClickhouseType(CKNull, CKTuple, CKArray, CKString, CKInt32) )+import Control.Monad.Writer (WriterT (runWriterT))+import qualified Data.Aeson as JP+import Data.Attoparsec.ByteString (IResult (Done, Fail), parse)+import qualified Data.ByteString.Char8 as C8+import qualified Data.HashMap.Strict as HM+import Data.Maybe (fromMaybe)+import Data.Text (pack)+import Data.Vector (toList) import Database.ClickHouseDriver.HTTP.Connection- ( HttpConnection(HttpConnection, httpParams) )-import Database.ClickHouseDriver.HTTP.Types ( Cmd, JSONResult, HttpParams(..))-import Database.ClickHouseDriver.IO.BufferedWriter ( writeIn )-import Control.Monad.Writer ( WriterT(runWriterT) )-import qualified Data.Aeson as JP-import Data.Attoparsec.ByteString ( IResult(Done, Fail), parse )-import qualified Data.ByteString.Char8 as C8-import qualified Data.HashMap.Strict as HM-import Data.Text (pack)-import Data.Vector (toList)-import qualified Network.URI.Encode as NE-import Data.Maybe ( fromMaybe )+ ( HttpConnection (HttpConnection, httpParams),+ )+import Database.ClickHouseDriver.HTTP.Types (Cmd, HttpParams (..), JSONResult)+import Database.ClickHouseDriver.IO.BufferedWriter (writeIn)+import Database.ClickHouseDriver.Types+ ( ClickhouseType (CKArray, CKInt32, CKNull, CKString, CKTuple),+ )+import qualified Network.URI.Encode as NE -- | Trim JSON data extract :: C8.ByteString -> JSONResult extract val = getData $ parse JP.json val where- getData (Fail e _ _) = Left e+ getData (Fail e _ _) = Left e getData (Done _ (JP.Object x)) = Right $ getData' x- getData _ = Right []+ getData _ = Right [] getData' = map getObject . maybeArrToList . HM.lookup (pack "data") @@ -47,42 +47,44 @@ getArray (JP.Array arr) = arr getObject (JP.Object x) = x -genURL :: HttpConnection->Cmd->IO String-genURL HttpConnection {- httpParams = HttpParams{- httpHost = host,- httpPassword = pw, - httpPort = port, +genURL :: HttpConnection -> Cmd -> IO String+genURL+ HttpConnection+ { httpParams =+ HttpParams+ { httpHost = host,+ httpPassword = pw,+ httpPort = port, httpUsername = usr, httpDatabase = db- }- }- cmd = do- (_,basicUrl) <- runWriterT $ do- writeIn "http://"- writeIn usr- writeIn ":"- writeIn pw- writeIn "@"- writeIn host- writeIn ":"- writeIn $ show port - writeIn "/"- if cmd == "ping" then return () else writeIn "?query="- writeIn $ dbUrl db- let res = basicUrl ++ NE.encode cmd- return res+ }+ }+ cmd = do+ (_, basicUrl) <- runWriterT $ do+ writeIn "http://"+ writeIn usr+ writeIn ":"+ writeIn pw+ writeIn "@"+ writeIn host+ writeIn ":"+ writeIn $ show port+ writeIn "/"+ if cmd == "ping" then return () else writeIn "?query="+ writeIn $ dbUrl db+ let res = basicUrl ++ NE.encode cmd+ return res -- | serialize column type into sql string-toString :: [ClickhouseType]->String+toString :: [ClickhouseType] -> String toString ck = "(" ++ toStr ck ++ ")" -toStr :: [ClickhouseType]->String+toStr :: [ClickhouseType] -> String toStr [] = ""-toStr (x:[]) = toStr' x-toStr (x:xs) = toStr' x ++ "," ++ toStr xs+toStr (x : []) = toStr' x+toStr (x : xs) = toStr' x ++ "," ++ toStr xs -toStr' :: ClickhouseType->String+toStr' :: ClickhouseType -> String toStr' (CKInt32 n) = show n toStr' (CKString str) = "'" ++ C8.unpack str ++ "'" toStr' (CKArray arr) = "[" ++ (toStr $ toList arr) ++ "]"@@ -91,4 +93,4 @@ toStr' _ = error "unsupported writing type" dbUrl :: (Maybe String) -> String-dbUrl = fromMaybe "" . fmap ("?database=" ++) +dbUrl = fromMaybe "" . fmap ("?database=" ++)
src/Database/ClickHouseDriver/HTTP/Types.hs view
@@ -1,22 +1,20 @@ -- | Definition of types- module Database.ClickHouseDriver.HTTP.Types ( JSONResult (..), Cmd, Haxl,- Format(..),- HttpConnection(..),- HttpParams(..)+ Format (..),+ HttpConnection (..),+ HttpParams (..), ) where -import Data.Aeson (Value)-import Data.ByteString (ByteString)-import Data.HashMap.Strict (HashMap)-import Data.Text (Text)-import Haxl.Core (GenHaxl) -import Network.HTTP.Client ( Manager ) -+import Data.Aeson (Value)+import Data.ByteString (ByteString)+import Data.HashMap.Strict (HashMap)+import Data.Text (Text)+import Haxl.Core (GenHaxl)+import Network.HTTP.Client (Manager) type JSONResult = Either ByteString [HashMap Text Value] @@ -25,22 +23,19 @@ type Haxl a = GenHaxl () a data Format = CSV | JSON | TUPLE- deriving Eq+ deriving (Eq) -data HttpParams - = HttpParams- {- httpHost :: !String,- httpPort :: {-# UNPACK #-} !Int,- httpUsername :: !String,- httpPassword :: !String,- httpDatabase :: Maybe String- }+data HttpParams = HttpParams+ { httpHost :: !String,+ httpPort :: {-# UNPACK #-} !Int,+ httpUsername :: !String,+ httpPassword :: !String,+ httpDatabase :: Maybe String+ } -data HttpConnection- = HttpConnection- { httpParams :: !HttpParams,- -- ^ basic parameters- httpManager :: !Manager- -- ^ http manager - }+data HttpConnection = HttpConnection+ { -- | basic parameters+ httpParams :: !HttpParams,+ -- | http manager+ httpManager :: !Manager+ }