{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Database.ClickHouseDriver.HTTP.Client
(
setupEnv,
runQuery,
getByteString,
getJSON,
getText,
getTextM,
getJsonM,
insertOneRow,
insertMany,
ping,
exec,
insertFromFile,
defaultHttpClient,
httpClient,
defaultHttpPool,
)
where
import Control.Concurrent.Async (mapConcurrently)
import Control.Exception (SomeException, try)
import Control.Monad.State.Lazy (MonadIO (..))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.ByteString.Lazy.Builder
( char8,
lazyByteString,
toLazyByteString,
)
import qualified Data.ByteString.Lazy.Char8 as C8
import Data.Default.Class (def)
import Data.Hashable (Hashable (hashWithSalt))
import Data.Pool (Pool, withResource)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import Data.Time.Clock (NominalDiffTime)
import Data.Typeable (Typeable)
import Database.ClickHouseDriver.Defines as Defines
( _DEFAULT_HOST,
_DEFAULT_HTTP_PORT,
)
import Database.ClickHouseDriver.HTTP.Connection
( createHttpPool,
defaultHttpConnection,
httpConnectDb,
)
import Database.ClickHouseDriver.HTTP.Helpers
( extract,
genURL,
toString,
)
import Database.ClickHouseDriver.HTTP.Types (Format (..), HttpConnection (..), JSONResult)
import Database.ClickHouseDriver.Types (ClickhouseType)
import Haxl.Core
( BlockedFetch (..),
DataSource (fetch),
DataSourceName (..),
Env (userEnv),
GenHaxl,
PerformFetch (SyncFetch),
ShowP (..),
StateKey (State),
dataFetch,
initEnv,
putFailure,
putSuccess,
runHaxl,
stateEmpty,
stateSet,
)
import Network.HTTP.Client
( RequestBody (..),
httpLbs,
method,
parseRequest,
requestBody,
responseBody,
streamFile,
)
import Text.Printf (printf)
data HttpClient a where
FetchByteString :: String -> HttpClient BS.ByteString
FetchJSON :: String -> HttpClient BS.ByteString
FetchCSV :: String -> HttpClient BS.ByteString
FetchText :: String -> HttpClient BS.ByteString
Ping :: HttpClient BS.ByteString
deriving instance Show (HttpClient a)
deriving instance Typeable HttpClient
deriving instance Eq (HttpClient a)
instance ShowP HttpClient where showp :: HttpClient a -> String
showp = HttpClient a -> String
forall a. Show a => a -> String
show
instance Hashable (HttpClient a) where
hashWithSalt :: Int -> HttpClient a -> Int
hashWithSalt Int
salt (FetchByteString String
cmd) = Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt String
cmd
hashWithSalt Int
salt (FetchJSON String
cmd) = Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt String
cmd
hashWithSalt Int
salt (FetchCSV String
cmd) = Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt String
cmd
hashWithSalt Int
salt HttpClient a
Ping = Int -> ByteString -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (ByteString
"ok" :: BS.ByteString)
instance DataSourceName HttpClient where
dataSourceName :: Proxy HttpClient -> Text
dataSourceName Proxy HttpClient
_ = Text
"ClickhouseDataSource"
instance DataSource u HttpClient where
fetch :: State HttpClient -> Flags -> u -> PerformFetch HttpClient
fetch (State HttpClient
settings) Flags
_flags u
_usrenv = ([BlockedFetch HttpClient] -> IO ()) -> PerformFetch HttpClient
forall (req :: * -> *).
([BlockedFetch req] -> IO ()) -> PerformFetch req
SyncFetch (([BlockedFetch HttpClient] -> IO ()) -> PerformFetch HttpClient)
-> ([BlockedFetch HttpClient] -> IO ()) -> PerformFetch HttpClient
forall a b. (a -> b) -> a -> b
$ \[BlockedFetch HttpClient]
blockedFetches -> do
String -> Int -> IO ()
forall r. PrintfType r => String -> r
printf String
"Fetching %d queries.\n" ([BlockedFetch HttpClient] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockedFetch HttpClient]
blockedFetches)
[()]
res <- (BlockedFetch HttpClient -> IO ())
-> [BlockedFetch HttpClient] -> IO [()]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently (State HttpClient -> BlockedFetch HttpClient -> IO ()
fetchData State HttpClient
settings) [BlockedFetch HttpClient]
blockedFetches
case [()]
res of
[()] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance StateKey HttpClient where
data State HttpClient
= SingleHttp HttpConnection
| HttpPool (Pool HttpConnection)
class HttpEnvironment a where
toEnv :: a -> State HttpClient
pick :: a -> IO HttpConnection
instance HttpEnvironment HttpConnection where
toEnv :: HttpConnection -> State HttpClient
toEnv = HttpConnection -> State HttpClient
SingleHttp
pick :: HttpConnection -> IO HttpConnection
pick = HttpConnection -> IO HttpConnection
forall (m :: * -> *) a. Monad m => a -> m a
return
instance HttpEnvironment (Pool HttpConnection) where
toEnv :: Pool HttpConnection -> State HttpClient
toEnv = Pool HttpConnection -> State HttpClient
HttpPool
pick :: Pool HttpConnection -> IO HttpConnection
pick Pool HttpConnection
pool = Pool HttpConnection
-> (HttpConnection -> IO HttpConnection) -> IO HttpConnection
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Pool a -> (a -> m b) -> m b
withResource Pool HttpConnection
pool ((HttpConnection -> IO HttpConnection) -> IO HttpConnection)
-> (HttpConnection -> IO HttpConnection) -> IO HttpConnection
forall a b. (a -> b) -> a -> b
$ HttpConnection -> IO HttpConnection
forall (m :: * -> *) a. Monad m => a -> m a
return
fetchData ::
State HttpClient ->
BlockedFetch HttpClient ->
IO ()
fetchData :: State HttpClient -> BlockedFetch HttpClient -> IO ()
fetchData (State HttpClient
settings) BlockedFetch HttpClient
fetches = do
let (String
queryWithType, ResultVar ByteString
var) = case BlockedFetch HttpClient
fetches of
BlockedFetch (FetchJSON String
query) ResultVar a
var' -> (String
query String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" FORMAT JSON", ResultVar a
ResultVar ByteString
var')
BlockedFetch (FetchCSV String
query) ResultVar a
var' -> (String
query String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" FORMAT CSV", ResultVar a
ResultVar ByteString
var')
BlockedFetch (FetchByteString String
query) ResultVar a
var' -> (String
query, ResultVar a
ResultVar ByteString
var')
BlockedFetch HttpClient a
Ping ResultVar a
var' -> (String
"ping", ResultVar a
ResultVar ByteString
var')
Either SomeException ByteString
e <- IO ByteString -> IO (Either SomeException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try (IO ByteString -> IO (Either SomeException ByteString))
-> IO ByteString -> IO (Either SomeException ByteString)
forall a b. (a -> b) -> a -> b
$ do
case State HttpClient
settings of
SingleHttp http@(HttpConnection _ mng) -> do
String
url <- HttpConnection -> String -> IO String
genURL HttpConnection
http String
queryWithType
Request
req <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
url
ByteString
ans <- Response ByteString -> ByteString
forall body. Response body -> body
responseBody (Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response ByteString)
httpLbs Request
req Manager
mng
return $ ByteString -> ByteString
LBS.toStrict ByteString
ans
HttpPool pool ->
Pool HttpConnection
-> (HttpConnection -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Pool a -> (a -> m b) -> m b
withResource Pool HttpConnection
pool ((HttpConnection -> IO ByteString) -> IO ByteString)
-> (HttpConnection -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \conn :: HttpConnection
conn@(HttpConnection HttpParams
_ Manager
mng) -> do
String
url <- HttpConnection -> String -> IO String
genURL HttpConnection
conn String
queryWithType
Request
req <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
url
ByteString
ans <- Response ByteString -> ByteString
forall body. Response body -> body
responseBody (Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response ByteString)
httpLbs Request
req Manager
mng
return $ ByteString -> ByteString
LBS.toStrict ByteString
ans
(SomeException -> IO ())
-> (ByteString -> IO ())
-> Either SomeException ByteString
-> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(ResultVar ByteString -> SomeException -> IO ()
forall e a. Exception e => ResultVar a -> e -> IO ()
putFailure ResultVar ByteString
var)
(ResultVar ByteString -> ByteString -> IO ()
forall a. ResultVar a -> a -> IO ()
putSuccess ResultVar ByteString
var)
(Either SomeException ByteString
e :: Either SomeException (BS.ByteString))
getByteString :: String -> GenHaxl u w BS.ByteString
getByteString :: String -> GenHaxl u w ByteString
getByteString = HttpClient ByteString -> GenHaxl u w ByteString
forall u (r :: * -> *) a w.
(DataSource u r, Request r a) =>
r a -> GenHaxl u w a
dataFetch (HttpClient ByteString -> GenHaxl u w ByteString)
-> (String -> HttpClient ByteString)
-> String
-> GenHaxl u w ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HttpClient ByteString
FetchByteString
getText :: String -> GenHaxl u w T.Text
getText :: String -> GenHaxl u w Text
getText String
cmd = (ByteString -> Text) -> GenHaxl u w ByteString -> GenHaxl u w Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8 (String -> GenHaxl u w ByteString
forall u w. String -> GenHaxl u w ByteString
getByteString String
cmd)
getJSON :: String -> GenHaxl u w JSONResult
getJSON :: String -> GenHaxl u w JSONResult
getJSON String
cmd = (ByteString -> JSONResult)
-> GenHaxl u w ByteString -> GenHaxl u w JSONResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> JSONResult
extract (HttpClient ByteString -> GenHaxl u w ByteString
forall u (r :: * -> *) a w.
(DataSource u r, Request r a) =>
r a -> GenHaxl u w a
dataFetch (HttpClient ByteString -> GenHaxl u w ByteString)
-> HttpClient ByteString -> GenHaxl u w ByteString
forall a b. (a -> b) -> a -> b
$ String -> HttpClient ByteString
FetchJSON String
cmd)
getTextM :: (Monad m, Traversable m) => m String -> GenHaxl u w (m T.Text)
getTextM :: m String -> GenHaxl u w (m Text)
getTextM = (String -> GenHaxl u w Text) -> m String -> GenHaxl u w (m Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> GenHaxl u w Text
forall u w. String -> GenHaxl u w Text
getText
getJsonM :: (Monad m, Traversable m) => m String -> GenHaxl u w (m JSONResult)
getJsonM :: m String -> GenHaxl u w (m JSONResult)
getJsonM = (String -> GenHaxl u w JSONResult)
-> m String -> GenHaxl u w (m JSONResult)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> GenHaxl u w JSONResult
forall u w. String -> GenHaxl u w JSONResult
getJSON
exec :: (HttpEnvironment a) => String -> Env a w -> IO (Either C8.ByteString String)
exec :: String -> Env a w -> IO (Either ByteString String)
exec String
cmd' Env a w
env = do
let cmd :: ByteString
cmd = String -> ByteString
C8.pack String
cmd'
conn :: HttpConnection
conn@HttpConnection {httpManager :: HttpConnection -> Manager
httpManager = Manager
mng} <- a -> IO HttpConnection
forall a. HttpEnvironment a => a -> IO HttpConnection
pick (a -> IO HttpConnection) -> a -> IO HttpConnection
forall a b. (a -> b) -> a -> b
$ Env a w -> a
forall u w. Env u w -> u
userEnv Env a w
env
String
url <- HttpConnection -> String -> IO String
genURL HttpConnection
conn String
""
Request
req <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
url
ByteString
ans <-
Response ByteString -> ByteString
forall body. Response body -> body
responseBody
(Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response ByteString)
httpLbs
Request
req
{ method :: ByteString
method = ByteString
"POST",
requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS ByteString
cmd
}
Manager
mng
if ByteString
ans ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
""
then Either ByteString String -> IO (Either ByteString String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString String -> IO (Either ByteString String))
-> Either ByteString String -> IO (Either ByteString String)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString String
forall a b. a -> Either a b
Left ByteString
ans
else Either ByteString String -> IO (Either ByteString String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString String -> IO (Either ByteString String))
-> Either ByteString String -> IO (Either ByteString String)
forall a b. (a -> b) -> a -> b
$ String -> Either ByteString String
forall a b. b -> Either a b
Right String
"Created successfully"
insertOneRow ::
(HttpEnvironment a) =>
String ->
[ClickhouseType] ->
Env a w ->
IO (Either C8.ByteString String)
insertOneRow :: String
-> [ClickhouseType] -> Env a w -> IO (Either ByteString String)
insertOneRow String
table_name [ClickhouseType]
arr Env a w
environment = do
let row :: String
row = [ClickhouseType] -> String
toString [ClickhouseType]
arr
let cmd :: ByteString
cmd = String -> ByteString
C8.pack (String
"INSERT INTO " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
table_name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" VALUES " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
row)
settings :: HttpConnection
settings@HttpConnection {httpManager :: HttpConnection -> Manager
httpManager = Manager
mng} <- a -> IO HttpConnection
forall a. HttpEnvironment a => a -> IO HttpConnection
pick (a -> IO HttpConnection) -> a -> IO HttpConnection
forall a b. (a -> b) -> a -> b
$ Env a w -> a
forall u w. Env u w -> u
userEnv Env a w
environment
String
url <- HttpConnection -> String -> IO String
genURL HttpConnection
settings String
""
Request
req <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
url
ByteString
ans <-
Response ByteString -> ByteString
forall body. Response body -> body
responseBody
(Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response ByteString)
httpLbs
Request
req
{ method :: ByteString
method = ByteString
"POST",
requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS ByteString
cmd
}
Manager
mng
if ByteString
ans ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
""
then Either ByteString String -> IO (Either ByteString String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString String -> IO (Either ByteString String))
-> Either ByteString String -> IO (Either ByteString String)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString String
forall a b. a -> Either a b
Left ByteString
ans
else Either ByteString String -> IO (Either ByteString String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString String -> IO (Either ByteString String))
-> Either ByteString String -> IO (Either ByteString String)
forall a b. (a -> b) -> a -> b
$ String -> Either ByteString String
forall a b. b -> Either a b
Right String
"Inserted successfully"
insertMany ::
(HttpEnvironment a) =>
String ->
[[ClickhouseType]] ->
Env a w ->
IO (Either C8.ByteString String)
insertMany :: String
-> [[ClickhouseType]] -> Env a w -> IO (Either ByteString String)
insertMany String
table_name [[ClickhouseType]]
rows Env a w
environment = do
let rowsString :: [Builder]
rowsString = ([ClickhouseType] -> Builder) -> [[ClickhouseType]] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Builder
lazyByteString (ByteString -> Builder)
-> ([ClickhouseType] -> ByteString) -> [ClickhouseType] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
C8.pack (String -> ByteString)
-> ([ClickhouseType] -> String) -> [ClickhouseType] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ClickhouseType] -> String
toString) [[ClickhouseType]]
rows
comma :: Builder
comma = Char -> Builder
char8 Char
','
preset :: Builder
preset = ByteString -> Builder
lazyByteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ String -> ByteString
C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"INSERT INTO " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
table_name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" VALUES "
togo :: Builder
togo = Builder
preset Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((Builder -> Builder -> Builder) -> [Builder] -> Builder
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\Builder
x Builder
y -> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
comma Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
y) [Builder]
rowsString)
settings :: HttpConnection
settings@HttpConnection {httpManager :: HttpConnection -> Manager
httpManager = Manager
mng} <- a -> IO HttpConnection
forall a. HttpEnvironment a => a -> IO HttpConnection
pick (a -> IO HttpConnection) -> a -> IO HttpConnection
forall a b. (a -> b) -> a -> b
$ Env a w -> a
forall u w. Env u w -> u
userEnv Env a w
environment
String
url <- HttpConnection -> String -> IO String
genURL HttpConnection
settings String
""
Request
req <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
url
ByteString
ans <-
Response ByteString -> ByteString
forall body. Response body -> body
responseBody
(Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response ByteString)
httpLbs
Request
req
{ method :: ByteString
method = ByteString
"POST",
requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString Builder
togo
}
Manager
mng
String -> IO ()
forall a. Show a => a -> IO ()
print String
"inserted successfully"
if ByteString
ans ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
""
then Either ByteString String -> IO (Either ByteString String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString String -> IO (Either ByteString String))
-> Either ByteString String -> IO (Either ByteString String)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString String
forall a b. a -> Either a b
Left ByteString
ans
else Either ByteString String -> IO (Either ByteString String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString String -> IO (Either ByteString String))
-> Either ByteString String -> IO (Either ByteString String)
forall a b. (a -> b) -> a -> b
$ String -> Either ByteString String
forall a b. b -> Either a b
Right String
"Successful insertion"
insertFromFile ::
(HttpEnvironment a) =>
String ->
Format ->
FilePath ->
Env a w ->
IO (Either C8.ByteString String)
insertFromFile :: String
-> Format -> String -> Env a w -> IO (Either ByteString String)
insertFromFile String
table_name Format
format String
file Env a w
environment = do
RequestBody
fileReqBody <- String -> IO RequestBody
streamFile String
file
settings :: HttpConnection
settings@HttpConnection {httpManager :: HttpConnection -> Manager
httpManager = Manager
mng} <- a -> IO HttpConnection
forall a. HttpEnvironment a => a -> IO HttpConnection
pick (a -> IO HttpConnection) -> a -> IO HttpConnection
forall a b. (a -> b) -> a -> b
$ Env a w -> a
forall u w. Env u w -> u
userEnv Env a w
environment
String
url <-
HttpConnection -> String -> IO String
genURL
HttpConnection
settings
( String
"INSERT INTO " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
table_name
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> case Format
format of
Format
CSV -> String
" FORMAT CSV"
Format
JSON -> String
" FORMAT JSON"
Format
TUPLE -> String
" VALUES"
)
Request
req <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
url
ByteString
ans <-
Response ByteString -> ByteString
forall body. Response body -> body
responseBody
(Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response ByteString)
httpLbs
Request
req
{ method :: ByteString
method = ByteString
"POST",
requestBody :: RequestBody
requestBody = RequestBody
fileReqBody
}
Manager
mng
if ByteString
ans ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
""
then Either ByteString String -> IO (Either ByteString String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString String -> IO (Either ByteString String))
-> Either ByteString String -> IO (Either ByteString String)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString String
forall a b. a -> Either a b
Left ByteString
ans
else Either ByteString String -> IO (Either ByteString String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString String -> IO (Either ByteString String))
-> Either ByteString String -> IO (Either ByteString String)
forall a b. (a -> b) -> a -> b
$ String -> Either ByteString String
forall a b. b -> Either a b
Right String
"Inserted successfully"
ping :: GenHaxl u w BS.ByteString
ping :: GenHaxl u w ByteString
ping = HttpClient ByteString -> GenHaxl u w ByteString
forall u (r :: * -> *) a w.
(DataSource u r, Request r a) =>
r a -> GenHaxl u w a
dataFetch (HttpClient ByteString -> GenHaxl u w ByteString)
-> HttpClient ByteString -> GenHaxl u w ByteString
forall a b. (a -> b) -> a -> b
$ HttpClient ByteString
Ping
setupEnv :: (MonadIO m, HttpEnvironment a) => a -> m (Env a w)
setupEnv :: a -> m (Env a w)
setupEnv a
csetting = IO (Env a w) -> m (Env a w)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Env a w) -> m (Env a w)) -> IO (Env a w) -> m (Env a w)
forall a b. (a -> b) -> a -> b
$ StateStore -> a -> IO (Env a w)
forall u w. StateStore -> u -> IO (Env u w)
initEnv (State HttpClient -> StateStore -> StateStore
forall (f :: * -> *).
StateKey f =>
State f -> StateStore -> StateStore
stateSet (a -> State HttpClient
forall a. HttpEnvironment a => a -> State HttpClient
toEnv a
csetting) StateStore
stateEmpty) a
csetting
defaultHttpClient :: (MonadIO m) => m (Env HttpConnection w)
defaultHttpClient :: m (Env HttpConnection w)
defaultHttpClient = IO (Env HttpConnection w) -> m (Env HttpConnection w)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Env HttpConnection w) -> m (Env HttpConnection w))
-> IO (Env HttpConnection w) -> m (Env HttpConnection w)
forall a b. (a -> b) -> a -> b
$ IO HttpConnection
defaultHttpConnection IO HttpConnection
-> (HttpConnection -> IO (Env HttpConnection w))
-> IO (Env HttpConnection w)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HttpConnection -> IO (Env HttpConnection w)
forall (m :: * -> *) a w.
(MonadIO m, HttpEnvironment a) =>
a -> m (Env a w)
setupEnv
defaultHttpPool :: (MonadIO m) => Int -> NominalDiffTime -> Int -> m (Env (Pool HttpConnection) w)
defaultHttpPool :: Int -> NominalDiffTime -> Int -> m (Env (Pool HttpConnection) w)
defaultHttpPool Int
numStripes NominalDiffTime
idleTime Int
maxResources =
IO (Env (Pool HttpConnection) w) -> m (Env (Pool HttpConnection) w)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Env (Pool HttpConnection) w)
-> m (Env (Pool HttpConnection) w))
-> IO (Env (Pool HttpConnection) w)
-> m (Env (Pool HttpConnection) w)
forall a b. (a -> b) -> a -> b
$ HttpParams
-> Int -> NominalDiffTime -> Int -> IO (Pool HttpConnection)
createHttpPool HttpParams
forall a. Default a => a
def Int
numStripes NominalDiffTime
idleTime Int
maxResources IO (Pool HttpConnection)
-> (Pool HttpConnection -> IO (Env (Pool HttpConnection) w))
-> IO (Env (Pool HttpConnection) w)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pool HttpConnection -> IO (Env (Pool HttpConnection) w)
forall (m :: * -> *) a w.
(MonadIO m, HttpEnvironment a) =>
a -> m (Env a w)
setupEnv
httpClient :: (MonadIO m) => String -> String -> m (Env HttpConnection w)
httpClient :: String -> String -> m (Env HttpConnection w)
httpClient String
user String
password = IO (Env HttpConnection w) -> m (Env HttpConnection w)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Env HttpConnection w) -> m (Env HttpConnection w))
-> IO (Env HttpConnection w) -> m (Env HttpConnection w)
forall a b. (a -> b) -> a -> b
$ String
-> String -> Int -> String -> Maybe String -> IO HttpConnection
httpConnectDb String
user String
password Int
Defines._DEFAULT_HTTP_PORT String
Defines._DEFAULT_HOST Maybe String
forall a. Maybe a
Nothing IO HttpConnection
-> (HttpConnection -> IO (Env HttpConnection w))
-> IO (Env HttpConnection w)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HttpConnection -> IO (Env HttpConnection w)
forall (m :: * -> *) a w.
(MonadIO m, HttpEnvironment a) =>
a -> m (Env a w)
setupEnv
{-# INLINE runQuery #-}
runQuery :: (MonadIO m) => Env u w -> GenHaxl u w a -> m a
runQuery :: Env u w -> GenHaxl u w a -> m a
runQuery Env u w
env GenHaxl u w a
haxl = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Env u w -> GenHaxl u w a -> IO a
forall u w a. Env u w -> GenHaxl u w a -> IO a
runHaxl Env u w
env GenHaxl u w a
haxl