{-# LANGUAGE
    AllowAmbiguousTypes
  , DerivingStrategies
  , DeriveAnyClass
  , DeriveGeneric
  , RankNTypes
#-}

module ClickHaskell.HTTP where

-- GHC included
import Control.DeepSeq         (NFData)
import Control.Exception       (Exception, SomeException, throw)
import Data.ByteString         as BS (StrictByteString)
import Data.ByteString.Builder (Builder)
import Data.Text               as T (Text)
import GHC.Generics            (Generic)

-- ToDo: Move it into internal ClickHaskell-HTTP package
insertIntoHttpGeneric
  :: forall request response record
  .  ImpliesClickHouseHttp request response
  => ChCredential
  -> Builder
  -> (record -> Builder)
  -> [record]
  -> (request -> (forall result. (response -> IO result) -> IO result))
  -> IO ()
insertIntoHttpGeneric :: forall request response record.
ImpliesClickHouseHttp request response =>
ChCredential
-> Builder
-> (record -> Builder)
-> [record]
-> (request -> forall result. (response -> IO result) -> IO result)
-> IO ()
insertIntoHttpGeneric ChCredential
credential Builder
query record -> Builder
encoder [record]
records request -> forall result. (response -> IO result) -> IO result
runClient = forall request response rec.
ImpliesClickHouseHttp request response =>
Builder -> [rec] -> (rec -> Builder) -> request -> request
injectWritingToRequest
  @request
  @response
  Builder
query
  [record]
records
  record -> Builder
encoder
  ((SomeException -> request)
-> (request -> request) -> Either SomeException request -> request
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> request
forall a e. Exception e => e -> a
throw request -> request
forall a. a -> a
id (Either SomeException request -> request)
-> Either SomeException request -> request
forall a b. (a -> b) -> a -> b
$ forall request response.
ImpliesClickHouseHttp request response =>
ChCredential -> Either SomeException request
initAuthorizedRequest @request @response ChCredential
credential)
  request -> forall result. (response -> IO result) -> IO result
`runClient` \response
response -> do
    response
_ <- forall request response.
ImpliesClickHouseHttp request response =>
response -> IO response
throwOnNon200 @request response
response
    () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

selectFromHttpGeneric
  :: forall request response record
  .  ImpliesClickHouseHttp request response
  => ChCredential
  -> Builder
  -> (StrictByteString -> record)
  -> (request -> (forall result . (response -> IO result) -> IO result))
  -> IO [record]
selectFromHttpGeneric :: forall request response record.
ImpliesClickHouseHttp request response =>
ChCredential
-> Builder
-> (StrictByteString -> record)
-> (request -> forall result. (response -> IO result) -> IO result)
-> IO [record]
selectFromHttpGeneric ChCredential
credential Builder
query StrictByteString -> record
decoder request -> forall result. (response -> IO result) -> IO result
runClient =
  (forall request response.
ImpliesClickHouseHttp request response =>
Builder -> request -> request
injectStatementToRequest @request @response Builder
query (request -> request)
-> (Either SomeException request -> request)
-> Either SomeException request
-> request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> request)
-> (request -> request) -> Either SomeException request -> request
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> request
forall a e. Exception e => e -> a
throw request -> request
forall a. a -> a
id)
  (forall request response.
ImpliesClickHouseHttp request response =>
ChCredential -> Either SomeException request
initAuthorizedRequest @request @response ChCredential
credential)
  request -> forall result. (response -> IO result) -> IO result
`runClient` \response
response -> do
    response
_ <- forall request response.
ImpliesClickHouseHttp request response =>
response -> IO response
throwOnNon200 @request response
response
    forall request response record.
ImpliesClickHouseHttp request response =>
(StrictByteString -> record) -> response -> IO [record]
injectReadingToResponse
      @request
      @response
      StrictByteString -> record
decoder
      response
response


-- * Clients abstraction

{- |
Clients initialization abstraction for different backends
-}
class ImpliesClickHouseHttp request response
  where
  initAuthorizedRequest :: ChCredential -> Either SomeException request

  injectStatementToRequest :: Builder -> (request -> request)

  injectReadingToResponse :: (StrictByteString -> record) -> (response -> IO [record])

  injectWritingToRequest :: Builder -> [rec] -> (rec -> Builder) -> (request -> request)

  throwOnNon200 :: response -> IO response

{- | ToDocument
-}
data ChCredential = MkChCredential
  { ChCredential -> Text
chLogin    :: !Text
  , ChCredential -> Text
chPass     :: !Text
  , ChCredential -> Text
chUrl      :: !Text
  , ChCredential -> Text
chDatabase :: !Text
  }
  deriving ((forall x. ChCredential -> Rep ChCredential x)
-> (forall x. Rep ChCredential x -> ChCredential)
-> Generic ChCredential
forall x. Rep ChCredential x -> ChCredential
forall x. ChCredential -> Rep ChCredential x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChCredential -> Rep ChCredential x
from :: forall x. ChCredential -> Rep ChCredential x
$cto :: forall x. Rep ChCredential x -> ChCredential
to :: forall x. Rep ChCredential x -> ChCredential
Generic, ChCredential -> ()
(ChCredential -> ()) -> NFData ChCredential
forall a. (a -> ()) -> NFData a
$crnf :: ChCredential -> ()
rnf :: ChCredential -> ()
NFData, Int -> ChCredential -> ShowS
[ChCredential] -> ShowS
ChCredential -> String
(Int -> ChCredential -> ShowS)
-> (ChCredential -> String)
-> ([ChCredential] -> ShowS)
-> Show ChCredential
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChCredential -> ShowS
showsPrec :: Int -> ChCredential -> ShowS
$cshow :: ChCredential -> String
show :: ChCredential -> String
$cshowList :: [ChCredential] -> ShowS
showList :: [ChCredential] -> ShowS
Show, ChCredential -> ChCredential -> Bool
(ChCredential -> ChCredential -> Bool)
-> (ChCredential -> ChCredential -> Bool) -> Eq ChCredential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChCredential -> ChCredential -> Bool
== :: ChCredential -> ChCredential -> Bool
$c/= :: ChCredential -> ChCredential -> Bool
/= :: ChCredential -> ChCredential -> Bool
Eq)

{- | ToDocument
-}
newtype ChException = MkChException
  { ChException -> Text
exceptionMessage :: Text
  }
  deriving (Int -> ChException -> ShowS
[ChException] -> ShowS
ChException -> String
(Int -> ChException -> ShowS)
-> (ChException -> String)
-> ([ChException] -> ShowS)
-> Show ChException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChException -> ShowS
showsPrec :: Int -> ChException -> ShowS
$cshow :: ChException -> String
show :: ChException -> String
$cshowList :: [ChException] -> ShowS
showList :: [ChException] -> ShowS
Show)
  deriving anyclass (Show ChException
Typeable ChException
(Typeable ChException, Show ChException) =>
(ChException -> SomeException)
-> (SomeException -> Maybe ChException)
-> (ChException -> String)
-> Exception ChException
SomeException -> Maybe ChException
ChException -> String
ChException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: ChException -> SomeException
toException :: ChException -> SomeException
$cfromException :: SomeException -> Maybe ChException
fromException :: SomeException -> Maybe ChException
$cdisplayException :: ChException -> String
displayException :: ChException -> String
Exception)