module ClickHaskell.Connection where

-- Internal
import ClickHaskell.Primitive

-- GHC included
import Control.Concurrent (MVar)
import Control.Exception (throwIO, SomeException, finally, catch, bracketOnError)
import Data.Binary.Builder (Builder, toLazyByteString)
import Data.ByteString as BS (ByteString, length)
import Data.IORef (atomicWriteIORef, newIORef, readIORef)
import Data.Maybe (fromMaybe)
import GHC.Exception (Exception)
import Prelude hiding (liftA2)

-- External
import Network.Socket hiding (SocketOption(..))
import Network.Socket (SocketOption(..))
import Network.Socket.ByteString (recv)
import Network.Socket.ByteString.Lazy (sendAll)
import System.Timeout (timeout)



-- * Connection

{- |
  Errors occured on connection operations
-}
data ConnectionError
  = NoAdressResolved
  -- ^ Occurs when 'getAddrInfo' returns an empty result
  | EstablishTimeout
  -- ^ Occurs on 'socket' connection timeout
  deriving (Int -> ConnectionError -> ShowS
[ConnectionError] -> ShowS
ConnectionError -> String
(Int -> ConnectionError -> ShowS)
-> (ConnectionError -> String)
-> ([ConnectionError] -> ShowS)
-> Show ConnectionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionError -> ShowS
showsPrec :: Int -> ConnectionError -> ShowS
$cshow :: ConnectionError -> String
show :: ConnectionError -> String
$cshowList :: [ConnectionError] -> ShowS
showList :: [ConnectionError] -> ShowS
Show, Show ConnectionError
Typeable ConnectionError
(Typeable ConnectionError, Show ConnectionError) =>
(ConnectionError -> SomeException)
-> (SomeException -> Maybe ConnectionError)
-> (ConnectionError -> String)
-> Exception ConnectionError
SomeException -> Maybe ConnectionError
ConnectionError -> String
ConnectionError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: ConnectionError -> SomeException
toException :: ConnectionError -> SomeException
$cfromException :: SomeException -> Maybe ConnectionError
fromException :: SomeException -> Maybe ConnectionError
$cdisplayException :: ConnectionError -> String
displayException :: ConnectionError -> String
Exception)

{- |
  These exceptions might indicate internal bugs.

  If you encounter one, please report it.
-}
data InternalError
  = UnexpectedPacketType UVarInt
  | DeserializationError String
  deriving (Int -> InternalError -> ShowS
[InternalError] -> ShowS
InternalError -> String
(Int -> InternalError -> ShowS)
-> (InternalError -> String)
-> ([InternalError] -> ShowS)
-> Show InternalError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InternalError -> ShowS
showsPrec :: Int -> InternalError -> ShowS
$cshow :: InternalError -> String
show :: InternalError -> String
$cshowList :: [InternalError] -> ShowS
showList :: [InternalError] -> ShowS
Show, Show InternalError
Typeable InternalError
(Typeable InternalError, Show InternalError) =>
(InternalError -> SomeException)
-> (SomeException -> Maybe InternalError)
-> (InternalError -> String)
-> Exception InternalError
SomeException -> Maybe InternalError
InternalError -> String
InternalError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: InternalError -> SomeException
toException :: InternalError -> SomeException
$cfromException :: SomeException -> Maybe InternalError
fromException :: SomeException -> Maybe InternalError
$cdisplayException :: InternalError -> String
displayException :: InternalError -> String
Exception)

writeToConnection :: ConnectionState -> (ProtocolRevision -> Builder) -> IO ()
writeToConnection :: ConnectionState -> (ProtocolRevision -> Builder) -> IO ()
writeToConnection MkConnectionState{ProtocolRevision
revision :: ProtocolRevision
revision :: ConnectionState -> ProtocolRevision
revision, Buffer
buffer :: Buffer
buffer :: ConnectionState -> Buffer
buffer} ProtocolRevision -> Builder
serializer =
  (Buffer -> Builder -> IO ()
writeConn Buffer
buffer) (ProtocolRevision -> Builder
serializer ProtocolRevision
revision)

data Connection where MkConnection :: (MVar ConnectionState) -> Connection

data ConnectionState = MkConnectionState
  { ConnectionState -> Buffer
buffer       :: Buffer
  , ConnectionState -> ProtocolRevision
revision     :: ProtocolRevision
  , ConnectionState -> ChString
initial_user :: ChString
  , ConnectionState -> ChString
os_user      :: ChString
  , ConnectionState -> ChString
hostname     :: ChString
  , ConnectionState -> ConnectionArgs
creds        :: ConnectionArgs
  }

createConnectionState
  :: (Buffer -> ConnectionArgs -> IO ConnectionState)
  -> ConnectionArgs
  -> IO ConnectionState
createConnectionState :: (Buffer -> ConnectionArgs -> IO ConnectionState)
-> ConnectionArgs -> IO ConnectionState
createConnectionState Buffer -> ConnectionArgs -> IO ConnectionState
postInitAction creds :: ConnectionArgs
creds@MkConnectionArgs{String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
user :: String
pass :: String
db :: String
host :: String
mPort :: Maybe String
defPort :: String
mOsUser :: Maybe String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
initSocket :: ConnectionArgs -> AddrInfo -> IO Socket
initBuffer :: ConnectionArgs -> String -> Socket -> IO Buffer
resolveHostName :: ConnectionArgs -> String -> String -> IO AddrInfo
mHostname :: ConnectionArgs -> Maybe String
mOsUser :: ConnectionArgs -> Maybe String
defPort :: ConnectionArgs -> String
mPort :: ConnectionArgs -> Maybe String
host :: ConnectionArgs -> String
db :: ConnectionArgs -> String
pass :: ConnectionArgs -> String
user :: ConnectionArgs -> String
..} = do
  let port :: String
port = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
defPort Maybe String
mPort
  Buffer
buffer <- String -> Socket -> IO Buffer
initBuffer String
host (Socket -> IO Buffer) -> IO Socket -> IO Buffer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AddrInfo -> IO Socket
initSocket (AddrInfo -> IO Socket) -> IO AddrInfo -> IO Socket
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> IO AddrInfo
resolveHostName String
host String
port
  Buffer -> ConnectionArgs -> IO ConnectionState
postInitAction Buffer
buffer ConnectionArgs
creds

recreateConnectionState
  :: (Buffer -> ConnectionArgs -> IO ConnectionState)
  -> ConnectionState
  -> IO ConnectionState
recreateConnectionState :: (Buffer -> ConnectionArgs -> IO ConnectionState)
-> ConnectionState -> IO ConnectionState
recreateConnectionState Buffer -> ConnectionArgs -> IO ConnectionState
postInitAction MkConnectionState{ConnectionArgs
creds :: ConnectionState -> ConnectionArgs
creds :: ConnectionArgs
creds, Buffer
buffer :: ConnectionState -> Buffer
buffer :: Buffer
buffer} = do
  Buffer -> IO ()
destroyBuff Buffer
buffer
  (Buffer -> ConnectionArgs -> IO ConnectionState)
-> ConnectionArgs -> IO ConnectionState
createConnectionState Buffer -> ConnectionArgs -> IO ConnectionState
postInitAction ConnectionArgs
creds

data Buffer = MkBuffer
  { Buffer -> IO ByteString
readBuff :: IO BS.ByteString
  , Buffer -> IO ()
destroyBuff :: IO ()
  , Buffer -> ByteString -> IO ()
writeBuff :: BS.ByteString -> IO ()
  , Buffer -> Builder -> IO ()
writeConn :: Builder -> IO ()
  }




-- * Initialization

{- |
  See `defaultConnectionArgs` for documentation
-}
data ConnectionArgs = MkConnectionArgs
  { ConnectionArgs -> String
user :: String
  , ConnectionArgs -> String
pass :: String
  , ConnectionArgs -> String
db   :: String
  , ConnectionArgs -> String
host :: HostName
  , ConnectionArgs -> Maybe String
mPort :: Maybe ServiceName
  , ConnectionArgs -> String
defPort :: ServiceName
  , ConnectionArgs -> Maybe String
mOsUser :: Maybe String
  , ConnectionArgs -> Maybe String
mHostname :: Maybe String
  , ConnectionArgs -> String -> String -> IO AddrInfo
resolveHostName :: HostName -> ServiceName -> IO AddrInfo
  , ConnectionArgs -> String -> Socket -> IO Buffer
initBuffer :: HostName -> Socket -> IO Buffer
  , ConnectionArgs -> AddrInfo -> IO Socket
initSocket :: AddrInfo -> IO Socket
  }

{- |
  Default connection settings which follows __clickhouse-client__ defaults

  Use `setUser`, `setPassword`, `setHost`, `setPort`, `setDatabase`
  to modify connection defaults.
-}
defaultConnectionArgs :: ConnectionArgs
defaultConnectionArgs :: ConnectionArgs
defaultConnectionArgs = MkConnectionArgs
  { user :: String
user = String
"default"
  , pass :: String
pass = String
""
  , host :: String
host = String
"localhost"
  , db :: String
db   = String
"default"
  , defPort :: String
defPort = String
"9000"
  , mPort :: Maybe String
mPort = Maybe String
forall a. Maybe a
Nothing
  , mOsUser :: Maybe String
mOsUser = Maybe String
forall a. Maybe a
Nothing
  , mHostname :: Maybe String
mHostname = Maybe String
forall a. Maybe a
Nothing
  , resolveHostName :: String -> String -> IO AddrInfo
resolveHostName = String -> String -> IO AddrInfo
defaultResolveHostName
  , initSocket :: AddrInfo -> IO Socket
initSocket = AddrInfo -> IO Socket
defaultInitSocket
  , initBuffer :: String -> Socket -> IO Buffer
initBuffer = String -> Socket -> IO Buffer
defaultInitBuffer
  }

defaultResolveHostName :: HostName -> ServiceName -> IO AddrInfo
defaultResolveHostName :: String -> String -> IO AddrInfo
defaultResolveHostName String
host String
port = do
  let hints :: AddrInfo
hints = AddrInfo
defaultHints{addrFlags = [AI_ADDRCONFIG], addrSocketType = Stream}
  [AddrInfo]
addrs <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
forall (t :: * -> *).
GetAddrInfo t =>
Maybe AddrInfo -> Maybe String -> Maybe String -> IO (t AddrInfo)
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) (String -> Maybe String
forall a. a -> Maybe a
Just String
host) (String -> Maybe String
forall a. a -> Maybe a
Just String
port)
  case [AddrInfo]
addrs of
    []  -> ConnectionError -> IO AddrInfo
forall e a. Exception e => e -> IO a
throwIO ConnectionError
NoAdressResolved
    AddrInfo
x:[AddrInfo]
_ -> AddrInfo -> IO AddrInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddrInfo
x

defaultInitSocket :: AddrInfo -> IO Socket
defaultInitSocket :: AddrInfo -> IO Socket
defaultInitSocket AddrInfo{[AddrInfoFlag]
Maybe String
ProtocolNumber
SockAddr
Family
SocketType
addrFlags :: AddrInfo -> [AddrInfoFlag]
addrSocketType :: AddrInfo -> SocketType
addrFlags :: [AddrInfoFlag]
addrFamily :: Family
addrSocketType :: SocketType
addrProtocol :: ProtocolNumber
addrAddress :: SockAddr
addrCanonName :: Maybe String
addrCanonName :: AddrInfo -> Maybe String
addrAddress :: AddrInfo -> SockAddr
addrProtocol :: AddrInfo -> ProtocolNumber
addrFamily :: AddrInfo -> Family
..} = do
  IO Socket -> (Socket -> IO Socket) -> Maybe Socket -> IO Socket
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ConnectionError -> IO Socket
forall e a. Exception e => e -> IO a
throwIO ConnectionError
EstablishTimeout) Socket -> IO Socket
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Maybe Socket -> IO Socket) -> IO (Maybe Socket) -> IO Socket
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO Socket -> IO (Maybe Socket)
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
3_000_000 (
      IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
        (Family -> SocketType -> ProtocolNumber -> IO Socket
socket Family
addrFamily SocketType
addrSocketType ProtocolNumber
addrProtocol)
        (\Socket
sock ->
          forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch @SomeException
            (IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
finally (Socket -> ShutdownCmd -> IO ()
shutdown Socket
sock ShutdownCmd
ShutdownBoth) (Socket -> IO ()
close Socket
sock))
            (IO () -> SomeException -> IO ()
forall a b. a -> b -> a
const (IO () -> SomeException -> IO ())
-> IO () -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        )
      (\Socket
sock -> do
        Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock SocketOption
NoDelay Int
1
        Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock SocketOption
KeepAlive Int
1
        Socket -> SockAddr -> IO ()
connect Socket
sock SockAddr
addrAddress
        Socket -> IO Socket
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Socket
sock
      )
    )

defaultInitBuffer :: HostName -> Socket -> IO Buffer
defaultInitBuffer :: String -> Socket -> IO Buffer
defaultInitBuffer String
_hostname Socket
sock = 
  (Builder -> IO ()) -> IO ByteString -> IO () -> IO Buffer
mkBuffer
    (Socket -> ByteString -> IO ()
sendAll Socket
sock (ByteString -> IO ())
-> (Builder -> ByteString) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString)
    (Socket -> Int -> IO ByteString
recv Socket
sock Int
4096)
    (forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch @SomeException
      (IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
finally (Socket -> ShutdownCmd -> IO ()
shutdown Socket
sock ShutdownCmd
ShutdownBoth) (Socket -> IO ()
close Socket
sock))
      (IO () -> SomeException -> IO ()
forall a b. a -> b -> a
const (IO () -> SomeException -> IO ())
-> IO () -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    )

{- |
  Overrides default user __"default"__
-}
setUser :: String -> ConnectionArgs -> ConnectionArgs
setUser :: String -> ConnectionArgs -> ConnectionArgs
setUser String
new MkConnectionArgs{String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
initSocket :: ConnectionArgs -> AddrInfo -> IO Socket
initBuffer :: ConnectionArgs -> String -> Socket -> IO Buffer
resolveHostName :: ConnectionArgs -> String -> String -> IO AddrInfo
mHostname :: ConnectionArgs -> Maybe String
mOsUser :: ConnectionArgs -> Maybe String
defPort :: ConnectionArgs -> String
mPort :: ConnectionArgs -> Maybe String
host :: ConnectionArgs -> String
db :: ConnectionArgs -> String
pass :: ConnectionArgs -> String
user :: ConnectionArgs -> String
user :: String
pass :: String
db :: String
host :: String
mPort :: Maybe String
defPort :: String
mOsUser :: Maybe String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
..} = MkConnectionArgs{user :: String
user=String
new, String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
initSocket :: AddrInfo -> IO Socket
initBuffer :: String -> Socket -> IO Buffer
resolveHostName :: String -> String -> IO AddrInfo
mHostname :: Maybe String
mOsUser :: Maybe String
defPort :: String
mPort :: Maybe String
host :: String
db :: String
pass :: String
pass :: String
db :: String
host :: String
mPort :: Maybe String
defPort :: String
mOsUser :: Maybe String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
..}

{- |
  Overrides default password __""__
-}
setPassword :: String -> ConnectionArgs -> ConnectionArgs
setPassword :: String -> ConnectionArgs -> ConnectionArgs
setPassword String
new MkConnectionArgs{String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
initSocket :: ConnectionArgs -> AddrInfo -> IO Socket
initBuffer :: ConnectionArgs -> String -> Socket -> IO Buffer
resolveHostName :: ConnectionArgs -> String -> String -> IO AddrInfo
mHostname :: ConnectionArgs -> Maybe String
mOsUser :: ConnectionArgs -> Maybe String
defPort :: ConnectionArgs -> String
mPort :: ConnectionArgs -> Maybe String
host :: ConnectionArgs -> String
db :: ConnectionArgs -> String
pass :: ConnectionArgs -> String
user :: ConnectionArgs -> String
user :: String
pass :: String
db :: String
host :: String
mPort :: Maybe String
defPort :: String
mOsUser :: Maybe String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
..} = MkConnectionArgs{pass :: String
pass=String
new, String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
initSocket :: AddrInfo -> IO Socket
initBuffer :: String -> Socket -> IO Buffer
resolveHostName :: String -> String -> IO AddrInfo
mHostname :: Maybe String
mOsUser :: Maybe String
defPort :: String
mPort :: Maybe String
host :: String
db :: String
user :: String
user :: String
db :: String
host :: String
mPort :: Maybe String
defPort :: String
mOsUser :: Maybe String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
..}

{- |
  Overrides default hostname __"localhost"__
-}
setHost :: HostName -> ConnectionArgs -> ConnectionArgs
setHost :: String -> ConnectionArgs -> ConnectionArgs
setHost String
new MkConnectionArgs{String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
initSocket :: ConnectionArgs -> AddrInfo -> IO Socket
initBuffer :: ConnectionArgs -> String -> Socket -> IO Buffer
resolveHostName :: ConnectionArgs -> String -> String -> IO AddrInfo
mHostname :: ConnectionArgs -> Maybe String
mOsUser :: ConnectionArgs -> Maybe String
defPort :: ConnectionArgs -> String
mPort :: ConnectionArgs -> Maybe String
host :: ConnectionArgs -> String
db :: ConnectionArgs -> String
pass :: ConnectionArgs -> String
user :: ConnectionArgs -> String
user :: String
pass :: String
db :: String
host :: String
mPort :: Maybe String
defPort :: String
mOsUser :: Maybe String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
..} = MkConnectionArgs{host :: String
host=String
new, String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
initSocket :: AddrInfo -> IO Socket
initBuffer :: String -> Socket -> IO Buffer
resolveHostName :: String -> String -> IO AddrInfo
mHostname :: Maybe String
mOsUser :: Maybe String
defPort :: String
mPort :: Maybe String
db :: String
pass :: String
user :: String
user :: String
pass :: String
db :: String
mPort :: Maybe String
defPort :: String
mOsUser :: Maybe String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
..}

{- |
  Set a custom port instead of the default __9000__ (or __9443__ if TLS is used).

  The default port can only be overridden by 'overrideNetwork'.
-}
setPort :: ServiceName -> ConnectionArgs -> ConnectionArgs
setPort :: String -> ConnectionArgs -> ConnectionArgs
setPort String
new MkConnectionArgs{String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
initSocket :: ConnectionArgs -> AddrInfo -> IO Socket
initBuffer :: ConnectionArgs -> String -> Socket -> IO Buffer
resolveHostName :: ConnectionArgs -> String -> String -> IO AddrInfo
mHostname :: ConnectionArgs -> Maybe String
mOsUser :: ConnectionArgs -> Maybe String
defPort :: ConnectionArgs -> String
mPort :: ConnectionArgs -> Maybe String
host :: ConnectionArgs -> String
db :: ConnectionArgs -> String
pass :: ConnectionArgs -> String
user :: ConnectionArgs -> String
user :: String
pass :: String
db :: String
host :: String
mPort :: Maybe String
defPort :: String
mOsUser :: Maybe String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
..} = MkConnectionArgs{mPort :: Maybe String
mPort=String -> Maybe String
forall a. a -> Maybe a
Just String
new, String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
initSocket :: AddrInfo -> IO Socket
initBuffer :: String -> Socket -> IO Buffer
resolveHostName :: String -> String -> IO AddrInfo
mHostname :: Maybe String
mOsUser :: Maybe String
defPort :: String
host :: String
db :: String
pass :: String
user :: String
user :: String
pass :: String
db :: String
host :: String
defPort :: String
mOsUser :: Maybe String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
..} 

{- |
  Overrides default database __"default"__
-}
setDatabase :: String -> ConnectionArgs -> ConnectionArgs
setDatabase :: String -> ConnectionArgs -> ConnectionArgs
setDatabase String
new MkConnectionArgs{String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
initSocket :: ConnectionArgs -> AddrInfo -> IO Socket
initBuffer :: ConnectionArgs -> String -> Socket -> IO Buffer
resolveHostName :: ConnectionArgs -> String -> String -> IO AddrInfo
mHostname :: ConnectionArgs -> Maybe String
mOsUser :: ConnectionArgs -> Maybe String
defPort :: ConnectionArgs -> String
mPort :: ConnectionArgs -> Maybe String
host :: ConnectionArgs -> String
db :: ConnectionArgs -> String
pass :: ConnectionArgs -> String
user :: ConnectionArgs -> String
user :: String
pass :: String
db :: String
host :: String
mPort :: Maybe String
defPort :: String
mOsUser :: Maybe String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
..} = MkConnectionArgs{db :: String
db=String
new, String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
initSocket :: AddrInfo -> IO Socket
initBuffer :: String -> Socket -> IO Buffer
resolveHostName :: String -> String -> IO AddrInfo
mHostname :: Maybe String
mOsUser :: Maybe String
defPort :: String
mPort :: Maybe String
host :: String
pass :: String
user :: String
user :: String
pass :: String
host :: String
mPort :: Maybe String
defPort :: String
mOsUser :: Maybe String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
..}




-- * Overriders

{- |
  This function should be used when you want to override
  the default connection behaviour

  Designed to be passed into 'overrideNetwork'

  Watch __ClickHaskell-tls__ package for example
-}
mkBuffer
  :: (Builder -> IO ())
  -> IO ByteString
  -> IO ()
  -> IO Buffer 
mkBuffer :: (Builder -> IO ()) -> IO ByteString -> IO () -> IO Buffer
mkBuffer Builder -> IO ()
sendSock IO ByteString
readSock IO ()
closeSock = do
  IORef ByteString
buff <- ByteString -> IO (IORef ByteString)
forall a. a -> IO (IORef a)
newIORef ByteString
""
  let writeBuff :: ByteString -> IO ()
writeBuff ByteString
bs = IORef ByteString -> ByteString -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef ByteString
buff ByteString
bs

  Buffer -> IO Buffer
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MkBuffer
    { writeConn :: Builder -> IO ()
writeConn = Builder -> IO ()
sendSock
    , ByteString -> IO ()
writeBuff :: ByteString -> IO ()
writeBuff :: ByteString -> IO ()
writeBuff
    , readBuff :: IO ByteString
readBuff = do
      ByteString
currentBuffer <- IORef ByteString -> IO ByteString
forall a. IORef a -> IO a
readIORef IORef ByteString
buff
      case ByteString -> Int
BS.length ByteString
currentBuffer of
        Int
0 -> IO ByteString
readSock
        Int
_ -> ByteString -> IO ()
writeBuff ByteString
"" IO () -> IO ByteString -> IO ByteString
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
currentBuffer
    , destroyBuff :: IO ()
destroyBuff = do
      IO ()
closeSock
      ByteString -> IO ()
writeBuff ByteString
""
    }

{- |
  Overrides default client hostname value which is:

  1. __$HOSTNAME__ env variable value (if set)
  2. __""__ otherwise

  Client hostname being displayed in ClickHouse logs
-}
overrideHostname :: String -> ConnectionArgs -> ConnectionArgs
overrideHostname :: String -> ConnectionArgs -> ConnectionArgs
overrideHostname String
new MkConnectionArgs{String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
initSocket :: ConnectionArgs -> AddrInfo -> IO Socket
initBuffer :: ConnectionArgs -> String -> Socket -> IO Buffer
resolveHostName :: ConnectionArgs -> String -> String -> IO AddrInfo
mHostname :: ConnectionArgs -> Maybe String
mOsUser :: ConnectionArgs -> Maybe String
defPort :: ConnectionArgs -> String
mPort :: ConnectionArgs -> Maybe String
host :: ConnectionArgs -> String
db :: ConnectionArgs -> String
pass :: ConnectionArgs -> String
user :: ConnectionArgs -> String
user :: String
pass :: String
db :: String
host :: String
mPort :: Maybe String
defPort :: String
mOsUser :: Maybe String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
..} = MkConnectionArgs{mHostname :: Maybe String
mHostname=String -> Maybe String
forall a. a -> Maybe a
Just String
new, String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
initSocket :: AddrInfo -> IO Socket
initBuffer :: String -> Socket -> IO Buffer
resolveHostName :: String -> String -> IO AddrInfo
mOsUser :: Maybe String
defPort :: String
mPort :: Maybe String
host :: String
db :: String
pass :: String
user :: String
user :: String
pass :: String
db :: String
host :: String
mPort :: Maybe String
defPort :: String
mOsUser :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
..}

{- |
  Overrides default os_name value which is:
  1. __$USER__ variable value (if set)
  2. __""__ otherwise
-}
overrideOsUser :: String -> ConnectionArgs -> ConnectionArgs
overrideOsUser :: String -> ConnectionArgs -> ConnectionArgs
overrideOsUser String
new MkConnectionArgs{String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
initSocket :: ConnectionArgs -> AddrInfo -> IO Socket
initBuffer :: ConnectionArgs -> String -> Socket -> IO Buffer
resolveHostName :: ConnectionArgs -> String -> String -> IO AddrInfo
mHostname :: ConnectionArgs -> Maybe String
mOsUser :: ConnectionArgs -> Maybe String
defPort :: ConnectionArgs -> String
mPort :: ConnectionArgs -> Maybe String
host :: ConnectionArgs -> String
db :: ConnectionArgs -> String
pass :: ConnectionArgs -> String
user :: ConnectionArgs -> String
user :: String
pass :: String
db :: String
host :: String
mPort :: Maybe String
defPort :: String
mOsUser :: Maybe String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
..} = MkConnectionArgs{mOsUser :: Maybe String
mOsUser=String -> Maybe String
forall a. a -> Maybe a
Just String
new, String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
initSocket :: AddrInfo -> IO Socket
initBuffer :: String -> Socket -> IO Buffer
resolveHostName :: String -> String -> IO AddrInfo
mHostname :: Maybe String
defPort :: String
mPort :: Maybe String
host :: String
db :: String
pass :: String
user :: String
user :: String
pass :: String
db :: String
host :: String
mPort :: Maybe String
defPort :: String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
..}

overrideNetwork
  :: ServiceName
  -> (HostName -> Socket -> IO Buffer)
  -> (ConnectionArgs -> ConnectionArgs)
overrideNetwork :: String
-> (String -> Socket -> IO Buffer)
-> ConnectionArgs
-> ConnectionArgs
overrideNetwork
  String
newDefPort
  String -> Socket -> IO Buffer
newInitBuffer
  MkConnectionArgs {String
Maybe String
String -> String -> IO AddrInfo
String -> Socket -> IO Buffer
AddrInfo -> IO Socket
initSocket :: ConnectionArgs -> AddrInfo -> IO Socket
initBuffer :: ConnectionArgs -> String -> Socket -> IO Buffer
resolveHostName :: ConnectionArgs -> String -> String -> IO AddrInfo
mHostname :: ConnectionArgs -> Maybe String
mOsUser :: ConnectionArgs -> Maybe String
defPort :: ConnectionArgs -> String
mPort :: ConnectionArgs -> Maybe String
host :: ConnectionArgs -> String
db :: ConnectionArgs -> String
pass :: ConnectionArgs -> String
user :: ConnectionArgs -> String
user :: String
pass :: String
db :: String
host :: String
mPort :: Maybe String
defPort :: String
mOsUser :: Maybe String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initBuffer :: String -> Socket -> IO Buffer
initSocket :: AddrInfo -> IO Socket
..}
  =
  MkConnectionArgs
    { defPort :: String
defPort = String
newDefPort
    , initBuffer :: String -> Socket -> IO Buffer
initBuffer = String -> Socket -> IO Buffer
newInitBuffer
    , String
Maybe String
String -> String -> IO AddrInfo
AddrInfo -> IO Socket
initSocket :: AddrInfo -> IO Socket
resolveHostName :: String -> String -> IO AddrInfo
mHostname :: Maybe String
mOsUser :: Maybe String
mPort :: Maybe String
host :: String
db :: String
pass :: String
user :: String
user :: String
pass :: String
db :: String
host :: String
mPort :: Maybe String
mOsUser :: Maybe String
mHostname :: Maybe String
resolveHostName :: String -> String -> IO AddrInfo
initSocket :: AddrInfo -> IO Socket
..
    }