-- Copyright (c) 2020-present, EMQX, Inc.
-- All rights reserved.
--
-- This source code is distributed under the terms of a MIT license,
-- found in the LICENSE file.
-------------------------------------------------------------------------------
-- This module provides implementation of Connection pool for TCP network
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE NamedFieldPuns #-}
module Database.ClickHouseDriver.Pool 
(
  createConnectionPool
) where

import Database.ClickHouseDriver.Connection ( tcpConnect )
import Database.ClickHouseDriver.Defines
    ( _DEFAULT_USERNAME,
      _DEFAULT_HOST_NAME,
      _DEFAULT_PASSWORD,
      _DEFAULT_PORT_NAME,
      _DEFAULT_DATABASE,
      _DEFAULT_COMPRESSION_SETTING )
import Data.Pool ( createPool, Pool )
import Data.Time.Clock ( NominalDiffTime )
import Network.Socket (close)
import Data.Default.Class ( Default(..) )
import Database.ClickHouseDriver.Types
    ( ConnParams(..), TCPConnection(TCPConnection, tcpSocket) )

-- | default connection parameters (settings)
instance Default ConnParams where
    def :: ConnParams
def = ConnParams :: ByteString
-> ByteString
-> ByteString
-> ByteString
-> Bool
-> ByteString
-> ConnParams
ConnParams{
       username' :: ByteString
username'    = ByteString
_DEFAULT_USERNAME
      ,host' :: ByteString
host'        = ByteString
_DEFAULT_HOST_NAME
      ,port' :: ByteString
port'        = ByteString
_DEFAULT_PORT_NAME
      ,password' :: ByteString
password'    = ByteString
_DEFAULT_PASSWORD
      ,compression' :: Bool
compression' = Bool
_DEFAULT_COMPRESSION_SETTING
      ,database' :: ByteString
database'    = ByteString
_DEFAULT_DATABASE
    }

-- | Create connection pool
createConnectionPool :: ConnParams
                      -- ^ parameters for basic connection. 
                      ->Int
                      -- ^ number of stripes
                      ->NominalDiffTime
                      -- ^ idleTime for each resource when not using.
                      ->Int
                      -- ^ maximum number of resources.
                      ->IO (Pool TCPConnection)
createConnectionPool :: ConnParams
-> Int -> NominalDiffTime -> Int -> IO (Pool TCPConnection)
createConnectionPool
  ConnParams
    { ByteString
username' :: ByteString
username' :: ConnParams -> ByteString
username',
      ByteString
host' :: ByteString
host' :: ConnParams -> ByteString
host',
      ByteString
port' :: ByteString
port' :: ConnParams -> ByteString
port',
      ByteString
password' :: ByteString
password' :: ConnParams -> ByteString
password',
      Bool
compression' :: Bool
compression' :: ConnParams -> Bool
compression',
      ByteString
database' :: ByteString
database' :: ConnParams -> ByteString
database'
    }
  Int
numStripes
  NominalDiffTime
idleTime
  Int
maxResources = IO TCPConnection
-> (TCPConnection -> IO ())
-> Int
-> NominalDiffTime
-> Int
-> IO (Pool TCPConnection)
forall a.
IO a
-> (a -> IO ()) -> Int -> NominalDiffTime -> Int -> IO (Pool a)
createPool (do
      Either String TCPConnection
conn <- ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Bool
-> IO (Either String TCPConnection)
tcpConnect ByteString
host' ByteString
port' ByteString
username' ByteString
password' ByteString
database' Bool
compression'
      case Either String TCPConnection
conn of
          Left String
err -> String -> IO TCPConnection
forall a. HasCallStack => String -> a
error String
err
          Right TCPConnection
tcp -> TCPConnection -> IO TCPConnection
forall (m :: * -> *) a. Monad m => a -> m a
return TCPConnection
tcp
      ) (\TCPConnection{tcpSocket :: TCPConnection -> Socket
tcpSocket=Socket
sock}->Socket -> IO ()
close Socket
sock) 
      Int
numStripes NominalDiffTime
idleTime Int
maxResources