-- 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 Database.ClickHouseDriver.Column
    ( ClickhouseType(CKNull, CKTuple, CKArray, CKString, CKInt32) )
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 )

-- | 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]
++)