-- 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.
{-# LANGUAGE FlexibleInstances #-}

-- | Miscellaneous helper functions. User should not import it.
module Database.ClickHouseDriver.HTTP.Helpers
  ( extract,
    genURL,
    toString,
  )
where

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, 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 :: ByteString -> JSONResult
extract ByteString
val = IResult ByteString Value -> JSONResult
forall a. IResult a Value -> Either a [Object]
getData (IResult ByteString Value -> JSONResult)
-> IResult ByteString Value -> JSONResult
forall a b. (a -> b) -> a -> b
$ Parser Value -> ByteString -> IResult ByteString Value
forall a. Parser a -> ByteString -> Result a
parse Parser Value
JP.json ByteString
val
  where
    getData :: IResult a Value -> Either a [Object]
getData (Fail a
e [String]
_ String
_) = a -> Either a [Object]
forall a b. a -> Either a b
Left a
e
    getData (Done a
_ (JP.Object Object
x)) = [Object] -> Either a [Object]
forall a b. b -> Either a b
Right ([Object] -> Either a [Object]) -> [Object] -> Either a [Object]
forall a b. (a -> b) -> a -> b
$ Object -> [Object]
getData' Object
x
    getData IResult a Value
_ = [Object] -> Either a [Object]
forall a b. b -> Either a b
Right []

    getData' :: Object -> [Object]
getData' = (Value -> Object) -> [Value] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Object
getObject ([Value] -> [Object]) -> (Object -> [Value]) -> Object -> [Object]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Value -> [Value]
maybeArrToList (Maybe Value -> [Value])
-> (Object -> Maybe Value) -> Object -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (String -> Text
pack String
"data")

    maybeArrToList :: Maybe Value -> [Value]
maybeArrToList Maybe Value
Nothing = []
    maybeArrToList (Just Value
x) = Vector Value -> [Value]
forall a. Vector a -> [a]
toList (Vector Value -> [Value])
-> (Value -> Vector Value) -> Value -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Vector Value
getArray (Value -> [Value]) -> Value -> [Value]
forall a b. (a -> b) -> a -> b
$ Value
x

    getArray :: Value -> Vector Value
getArray (JP.Array Vector Value
arr) = Vector Value
arr
    getObject :: Value -> Object
getObject (JP.Object Object
x) = Object
x

genURL :: HttpConnection -> Cmd -> IO String
genURL :: HttpConnection -> String -> IO String
genURL
  HttpConnection
    { httpParams :: HttpConnection -> HttpParams
httpParams =
        HttpParams
          { httpHost :: HttpParams -> String
httpHost = String
host,
            httpPassword :: HttpParams -> String
httpPassword = String
pw,
            httpPort :: HttpParams -> Int
httpPort = Int
port,
            httpUsername :: HttpParams -> String
httpUsername = String
usr,
            httpDatabase :: HttpParams -> Maybe String
httpDatabase = Maybe String
db
          }
    }
  String
cmd = do
    (()
_, String
basicUrl) <- WriterT String IO () -> IO ((), String)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT String IO () -> IO ((), String))
-> WriterT String IO () -> IO ((), String)
forall a b. (a -> b) -> a -> b
$ do
      String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
"http://"
      String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
usr
      String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
":"
      String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
pw
      String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
"@"
      String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
host
      String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
":"
      String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn (String -> WriterT String IO ()) -> String -> WriterT String IO ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
port
      String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
"/"
      if String
cmd String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ping" then () -> WriterT String IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
"?query="
      String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn (String -> WriterT String IO ()) -> String -> WriterT String IO ()
forall a b. (a -> b) -> a -> b
$ Maybe String -> String
dbUrl Maybe String
db
    let res :: String
res = String
basicUrl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
NE.encode String
cmd
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
res

-- | serialize column type into sql string
toString :: [ClickhouseType] -> String
toString :: [ClickhouseType] -> String
toString [ClickhouseType]
ck = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ClickhouseType] -> String
toStr [ClickhouseType]
ck String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

toStr :: [ClickhouseType] -> String
toStr :: [ClickhouseType] -> String
toStr [] = String
""
toStr (ClickhouseType
x : []) = ClickhouseType -> String
toStr' ClickhouseType
x
toStr (ClickhouseType
x : [ClickhouseType]
xs) = ClickhouseType -> String
toStr' ClickhouseType
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ClickhouseType] -> String
toStr [ClickhouseType]
xs

toStr' :: ClickhouseType -> String
toStr' :: ClickhouseType -> String
toStr' (CKInt32 Int32
n) = Int32 -> String
forall a. Show a => a -> String
show Int32
n
toStr' (CKString ByteString
str) = String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
C8.unpack ByteString
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
toStr' (CKArray Vector ClickhouseType
arr) = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([ClickhouseType] -> String
toStr ([ClickhouseType] -> String) -> [ClickhouseType] -> String
forall a b. (a -> b) -> a -> b
$ Vector ClickhouseType -> [ClickhouseType]
forall a. Vector a -> [a]
toList Vector ClickhouseType
arr) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
toStr' (CKTuple Vector ClickhouseType
arr) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([ClickhouseType] -> String
toStr ([ClickhouseType] -> String) -> [ClickhouseType] -> String
forall a b. (a -> b) -> a -> b
$ Vector ClickhouseType -> [ClickhouseType]
forall a. Vector a -> [a]
toList Vector ClickhouseType
arr) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
toStr' ClickhouseType
CKNull = String
"null"
toStr' ClickhouseType
_ = String -> String
forall a. HasCallStack => String -> a
error String
"unsupported writing type"

dbUrl :: (Maybe String) -> String
dbUrl :: Maybe String -> String
dbUrl = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (Maybe String -> Maybe String) -> Maybe String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"?database=" String -> String -> String
forall a. [a] -> [a] -> [a]
++)