{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Database.Bloodhound.Client
(
withBH
, createIndex
, createIndexWith
, flushIndex
, deleteIndex
, updateIndexSettings
, getIndexSettings
, forceMergeIndex
, indexExists
, openIndex
, closeIndex
, listIndices
, catIndices
, waitForYellowIndex
, updateIndexAliases
, getIndexAliases
, deleteIndexAlias
, putTemplate
, templateExists
, deleteTemplate
, putMapping
, indexDocument
, updateDocument
, updateByQuery
, getDocument
, documentExists
, deleteDocument
, deleteByQuery
, searchAll
, searchByIndex
, searchByIndices
, searchByType
, scanSearch
, getInitialScroll
, getInitialSortedScroll
, advanceScroll
, refreshIndex
, mkSearch
, mkAggregateSearch
, mkHighlightSearch
, bulk
, pageSearch
, mkShardCount
, mkReplicaCount
, getStatus
, getSnapshotRepos
, updateSnapshotRepo
, verifySnapshotRepo
, deleteSnapshotRepo
, createSnapshot
, getSnapshots
, deleteSnapshot
, restoreSnapshot
, getNodesInfo
, getNodesStats
, encodeBulkOperations
, encodeBulkOperation
, basicAuthHook
, isVersionConflict
, isSuccess
, isCreated
, parseEsResponse
, countByIndex
, reindex
, reindexAsync
, getTask
)
where
import qualified Blaze.ByteString.Builder as BB
import Control.Applicative as A
import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Aeson
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Foldable (toList)
import Data.Functor.Identity (runIdentity)
import Data.Ix
import qualified Data.List as LS (filter, foldl')
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time.Clock
import qualified Data.Vector as V
import Network.HTTP.Client
import qualified Network.HTTP.Types.Method as NHTM
import qualified Network.HTTP.Types.Status as NHTS
import qualified Network.HTTP.Types.URI as NHTU
import qualified Network.URI as URI
import Prelude hiding (filter, head)
import Database.Bloodhound.Types
mkShardCount :: Int -> Maybe ShardCount
mkShardCount :: Int -> Maybe ShardCount
mkShardCount Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = Maybe ShardCount
forall a. Maybe a
Nothing
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1000 = Maybe ShardCount
forall a. Maybe a
Nothing
| Bool
otherwise = ShardCount -> Maybe ShardCount
forall a. a -> Maybe a
Just (Int -> ShardCount
ShardCount Int
n)
mkReplicaCount :: Int -> Maybe ReplicaCount
mkReplicaCount :: Int -> Maybe ReplicaCount
mkReplicaCount Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe ReplicaCount
forall a. Maybe a
Nothing
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1000 = Maybe ReplicaCount
forall a. Maybe a
Nothing
| Bool
otherwise = ReplicaCount -> Maybe ReplicaCount
forall a. a -> Maybe a
Just (Int -> ReplicaCount
ReplicaCount Int
n)
emptyBody :: L.ByteString
emptyBody :: ByteString
emptyBody = [Char] -> ByteString
L.pack [Char]
""
dispatch :: MonadBH m
=> Method
-> Text
-> Maybe L.ByteString
-> m Reply
dispatch :: forall (m :: * -> *).
MonadBH m =>
ByteString -> Text -> Maybe ByteString -> m Reply
dispatch ByteString
dMethod Text
url Maybe ByteString
body = do
Request
initReq <- IO Request -> m Request
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> m Request) -> IO Request -> m Request
forall a b. (a -> b) -> a -> b
$ Text -> IO Request
forall (m :: * -> *). MonadThrow m => Text -> m Request
parseUrl' Text
url
Request -> IO Request
reqHook <- BHEnv -> Request -> IO Request
bhRequestHook (BHEnv -> Request -> IO Request)
-> m BHEnv -> m (Request -> IO Request)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
A.<$> m BHEnv
forall (m :: * -> *). MonadBH m => m BHEnv
getBHEnv
let reqBody :: RequestBody
reqBody = ByteString -> RequestBody
RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
emptyBody Maybe ByteString
body
Request
req <- IO Request -> m Request
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO Request -> m Request) -> IO Request -> m Request
forall a b. (a -> b) -> a -> b
$ Request -> IO Request
reqHook
(Request -> IO Request) -> Request -> IO Request
forall a b. (a -> b) -> a -> b
$ Request -> Request
setRequestIgnoreStatus
(Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
initReq { method = dMethod
, requestHeaders =
("Content-Type", "application/json") : requestHeaders initReq
, requestBody = reqBody }
Manager
mgr <- BHEnv -> Manager
bhManager (BHEnv -> Manager) -> m BHEnv -> m Manager
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m BHEnv
forall (m :: * -> *). MonadBH m => m BHEnv
getBHEnv
IO Reply -> m Reply
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Reply -> m Reply) -> IO Reply -> m Reply
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO Reply
httpLbs Request
req Manager
mgr
joinPath' :: [Text] -> Text
joinPath' :: [Text] -> Text
joinPath' = Text -> [Text] -> Text
T.intercalate Text
"/"
joinPath :: MonadBH m => [Text] -> m Text
joinPath :: forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text]
ps = do
Server Text
s <- BHEnv -> Server
bhServer (BHEnv -> Server) -> m BHEnv -> m Server
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m BHEnv
forall (m :: * -> *). MonadBH m => m BHEnv
getBHEnv
Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
joinPath' (Text
sText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ps)
appendSearchTypeParam :: Text -> SearchType -> Text
appendSearchTypeParam :: Text -> SearchType -> Text
appendSearchTypeParam Text
originalUrl SearchType
st = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params Text
originalUrl
where stText :: Text
stText = Text
"search_type"
params :: [(Text, Maybe Text)]
params
| SearchType
st SearchType -> SearchType -> Bool
forall a. Eq a => a -> a -> Bool
== SearchType
SearchTypeDfsQueryThenFetch = [(Text
stText, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"dfs_query_then_fetch")]
| Bool
otherwise = []
addQuery :: [(Text, Maybe Text)] -> Text -> Text
addQuery :: [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
q Text
u = Text
u Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rendered
where
rendered :: Text
rendered =
ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> [(Text, Maybe Text)] -> Builder
NHTU.renderQueryText Bool
prependQuestionMark [(Text, Maybe Text)]
q
prependQuestionMark :: Bool
prependQuestionMark = Bool
True
bindM2 :: (Applicative m, Monad m) => (a -> b -> m c) -> m a -> m b -> m c
bindM2 :: forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 a -> b -> m c
f m a
ma m b
mb = m (m c) -> m c
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (a -> b -> m c
f (a -> b -> m c) -> m a -> m (b -> m c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
ma m (b -> m c) -> m b -> m (m c)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m b
mb)
withBH :: ManagerSettings -> Server -> BH IO a -> IO a
withBH :: forall a. ManagerSettings -> Server -> BH IO a -> IO a
withBH ManagerSettings
ms Server
s BH IO a
f = do
Manager
mgr <- ManagerSettings -> IO Manager
newManager ManagerSettings
ms
let env :: BHEnv
env = Server -> Manager -> BHEnv
mkBHEnv Server
s Manager
mgr
BHEnv -> BH IO a -> IO a
forall (m :: * -> *) a. BHEnv -> BH m a -> m a
runBH BHEnv
env BH IO a
f
delete :: MonadBH m => Text -> m Reply
delete :: forall (m :: * -> *). MonadBH m => Text -> m Reply
delete = (Text -> Maybe ByteString -> m Reply)
-> Maybe ByteString -> Text -> m Reply
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ByteString -> Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
ByteString -> Text -> Maybe ByteString -> m Reply
dispatch ByteString
NHTM.methodDelete) Maybe ByteString
forall a. Maybe a
Nothing
get :: MonadBH m => Text -> m Reply
get :: forall (m :: * -> *). MonadBH m => Text -> m Reply
get = (Text -> Maybe ByteString -> m Reply)
-> Maybe ByteString -> Text -> m Reply
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ByteString -> Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
ByteString -> Text -> Maybe ByteString -> m Reply
dispatch ByteString
NHTM.methodGet) Maybe ByteString
forall a. Maybe a
Nothing
head :: MonadBH m => Text -> m Reply
head :: forall (m :: * -> *). MonadBH m => Text -> m Reply
head = (Text -> Maybe ByteString -> m Reply)
-> Maybe ByteString -> Text -> m Reply
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ByteString -> Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
ByteString -> Text -> Maybe ByteString -> m Reply
dispatch ByteString
NHTM.methodHead) Maybe ByteString
forall a. Maybe a
Nothing
put :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
put :: forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put = ByteString -> Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
ByteString -> Text -> Maybe ByteString -> m Reply
dispatch ByteString
NHTM.methodPut
post :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
post :: forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post = ByteString -> Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
ByteString -> Text -> Maybe ByteString -> m Reply
dispatch ByteString
NHTM.methodPost
getStatus :: MonadBH m => m (Maybe Status)
getStatus :: forall (m :: * -> *). MonadBH m => m (Maybe Status)
getStatus = do
Reply
response <- Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
Maybe Status -> m (Maybe Status)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Status -> m (Maybe Status))
-> Maybe Status -> m (Maybe Status)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Status
forall a. FromJSON a => ByteString -> Maybe a
decode (Reply -> ByteString
forall body. Response body -> body
responseBody Reply
response)
where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath []
getSnapshotRepos
:: ( MonadBH m
, MonadThrow m
)
=> SnapshotRepoSelection
-> m (Either EsError [GenericSnapshotRepo])
getSnapshotRepos :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
SnapshotRepoSelection -> m (Either EsError [GenericSnapshotRepo])
getSnapshotRepos SnapshotRepoSelection
sel = (Either EsError GSRs -> Either EsError [GenericSnapshotRepo])
-> m (Either EsError GSRs)
-> m (Either EsError [GenericSnapshotRepo])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GSRs -> [GenericSnapshotRepo])
-> Either EsError GSRs -> Either EsError [GenericSnapshotRepo]
forall a b. (a -> b) -> Either EsError a -> Either EsError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GSRs -> [GenericSnapshotRepo]
unGSRs) (m (Either EsError GSRs)
-> m (Either EsError [GenericSnapshotRepo]))
-> (Reply -> m (Either EsError GSRs))
-> Reply
-> m (Either EsError [GenericSnapshotRepo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply -> m (Either EsError GSRs)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError [GenericSnapshotRepo]))
-> m Reply -> m (Either EsError [GenericSnapshotRepo])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_snapshot", Text
selectorSeg]
selectorSeg :: Text
selectorSeg = case SnapshotRepoSelection
sel of
SnapshotRepoSelection
AllSnapshotRepos -> Text
"_all"
SnapshotRepoList (SnapshotRepoPattern
p :| [SnapshotRepoPattern]
ps) -> Text -> [Text] -> Text
T.intercalate Text
"," (SnapshotRepoPattern -> Text
renderPat (SnapshotRepoPattern -> Text) -> [SnapshotRepoPattern] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SnapshotRepoPattern
pSnapshotRepoPattern
-> [SnapshotRepoPattern] -> [SnapshotRepoPattern]
forall a. a -> [a] -> [a]
:[SnapshotRepoPattern]
ps))
renderPat :: SnapshotRepoPattern -> Text
renderPat (RepoPattern Text
t) = Text
t
renderPat (ExactRepo (SnapshotRepoName Text
t)) = Text
t
newtype GSRs = GSRs { GSRs -> [GenericSnapshotRepo]
unGSRs :: [GenericSnapshotRepo] }
instance FromJSON GSRs where
parseJSON :: Value -> Parser GSRs
parseJSON = [Char] -> (Object -> Parser GSRs) -> Value -> Parser GSRs
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Collection of GenericSnapshotRepo" Object -> Parser GSRs
parse
where
parse :: Object -> Parser GSRs
parse = ([GenericSnapshotRepo] -> GSRs)
-> Parser [GenericSnapshotRepo] -> Parser GSRs
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [GenericSnapshotRepo] -> GSRs
GSRs (Parser [GenericSnapshotRepo] -> Parser GSRs)
-> (Object -> Parser [GenericSnapshotRepo])
-> Object
-> Parser GSRs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pair -> Parser GenericSnapshotRepo)
-> [Pair] -> Parser [GenericSnapshotRepo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Key -> Value -> Parser GenericSnapshotRepo)
-> Pair -> Parser GenericSnapshotRepo
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Value -> Parser GenericSnapshotRepo
go) ([Pair] -> Parser [GenericSnapshotRepo])
-> (Object -> [Pair]) -> Object -> Parser [GenericSnapshotRepo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList
go :: Key -> Value -> Parser GenericSnapshotRepo
go Key
rawName = [Char]
-> (Object -> Parser GenericSnapshotRepo)
-> Value
-> Parser GenericSnapshotRepo
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"GenericSnapshotRepo" ((Object -> Parser GenericSnapshotRepo)
-> Value -> Parser GenericSnapshotRepo)
-> (Object -> Parser GenericSnapshotRepo)
-> Value
-> Parser GenericSnapshotRepo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
SnapshotRepoName
-> SnapshotRepoType
-> GenericSnapshotRepoSettings
-> GenericSnapshotRepo
GenericSnapshotRepo (Text -> SnapshotRepoName
SnapshotRepoName (Key -> Text
Key.toText Key
rawName)) (SnapshotRepoType
-> GenericSnapshotRepoSettings -> GenericSnapshotRepo)
-> Parser SnapshotRepoType
-> Parser (GenericSnapshotRepoSettings -> GenericSnapshotRepo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser SnapshotRepoType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
Parser (GenericSnapshotRepoSettings -> GenericSnapshotRepo)
-> Parser GenericSnapshotRepoSettings -> Parser GenericSnapshotRepo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser GenericSnapshotRepoSettings
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"settings"
updateSnapshotRepo
:: ( MonadBH m
, SnapshotRepo repo
)
=> SnapshotRepoUpdateSettings
-> repo
-> m Reply
updateSnapshotRepo :: forall (m :: * -> *) repo.
(MonadBH m, SnapshotRepo repo) =>
SnapshotRepoUpdateSettings -> repo -> m Reply
updateSnapshotRepo SnapshotRepoUpdateSettings {Bool
repoUpdateVerify :: Bool
repoUpdateVerify :: SnapshotRepoUpdateSettings -> Bool
..} repo
repo =
(Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
body))
where
url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_snapshot", SnapshotRepoName -> Text
snapshotRepoName SnapshotRepoName
gSnapshotRepoName]
params :: [(Text, Maybe Text)]
params
| Bool
repoUpdateVerify = []
| Bool
otherwise = [(Text
"verify", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"false")]
body :: ByteString
body = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [ Key
"type" Key -> SnapshotRepoType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= SnapshotRepoType
gSnapshotRepoType
, Key
"settings" Key -> GenericSnapshotRepoSettings -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= GenericSnapshotRepoSettings
gSnapshotRepoSettings
]
GenericSnapshotRepo {GenericSnapshotRepoSettings
SnapshotRepoType
SnapshotRepoName
gSnapshotRepoName :: SnapshotRepoName
gSnapshotRepoType :: SnapshotRepoType
gSnapshotRepoSettings :: GenericSnapshotRepoSettings
gSnapshotRepoName :: GenericSnapshotRepo -> SnapshotRepoName
gSnapshotRepoType :: GenericSnapshotRepo -> SnapshotRepoType
gSnapshotRepoSettings :: GenericSnapshotRepo -> GenericSnapshotRepoSettings
..} = repo -> GenericSnapshotRepo
forall r. SnapshotRepo r => r -> GenericSnapshotRepo
toGSnapshotRepo repo
repo
verifySnapshotRepo
:: ( MonadBH m
, MonadThrow m
)
=> SnapshotRepoName
-> m (Either EsError SnapshotVerification)
verifySnapshotRepo :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
SnapshotRepoName -> m (Either EsError SnapshotVerification)
verifySnapshotRepo (SnapshotRepoName Text
n) =
Reply -> m (Either EsError SnapshotVerification)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError SnapshotVerification))
-> m Reply -> m (Either EsError SnapshotVerification)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing)
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_snapshot", Text
n, Text
"_verify"]
deleteSnapshotRepo :: MonadBH m => SnapshotRepoName -> m Reply
deleteSnapshotRepo :: forall (m :: * -> *). MonadBH m => SnapshotRepoName -> m Reply
deleteSnapshotRepo (SnapshotRepoName Text
n) = Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
delete (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_snapshot", Text
n]
createSnapshot
:: (MonadBH m)
=> SnapshotRepoName
-> SnapshotName
-> SnapshotCreateSettings
-> m Reply
createSnapshot :: forall (m :: * -> *).
MonadBH m =>
SnapshotRepoName
-> SnapshotName -> SnapshotCreateSettings -> m Reply
createSnapshot (SnapshotRepoName Text
repoName)
(SnapshotName Text
snapName)
SnapshotCreateSettings {Bool
Maybe IndexSelection
snapWaitForCompletion :: Bool
snapIndices :: Maybe IndexSelection
snapIgnoreUnavailable :: Bool
snapIncludeGlobalState :: Bool
snapPartial :: Bool
snapWaitForCompletion :: SnapshotCreateSettings -> Bool
snapIndices :: SnapshotCreateSettings -> Maybe IndexSelection
snapIgnoreUnavailable :: SnapshotCreateSettings -> Bool
snapIncludeGlobalState :: SnapshotCreateSettings -> Bool
snapPartial :: SnapshotCreateSettings -> Bool
..} =
(Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
body))
where
url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_snapshot", Text
repoName, Text
snapName]
params :: [(Text, Maybe Text)]
params = [(Text
"wait_for_completion", Text -> Maybe Text
forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
snapWaitForCompletion))]
body :: ByteString
body = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Pair]
prs
prs :: [Pair]
prs = [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [ (Key
"indices" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) (Text -> Pair)
-> (IndexSelection -> Text) -> IndexSelection -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexSelection -> Text
indexSelectionName (IndexSelection -> Pair) -> Maybe IndexSelection -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe IndexSelection
snapIndices
, Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"ignore_unavailable" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
snapIgnoreUnavailable)
, Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"ignore_global_state" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
snapIncludeGlobalState)
, Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"partial" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
snapPartial)
]
indexSelectionName :: IndexSelection -> Text
indexSelectionName :: IndexSelection -> Text
indexSelectionName IndexSelection
AllIndexes = Text
"_all"
indexSelectionName (IndexList (IndexName
i :| [IndexName]
is)) = Text -> [Text] -> Text
T.intercalate Text
"," (IndexName -> Text
renderIndex (IndexName -> Text) -> [IndexName] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IndexName
iIndexName -> [IndexName] -> [IndexName]
forall a. a -> [a] -> [a]
:[IndexName]
is))
where
renderIndex :: IndexName -> Text
renderIndex (IndexName Text
n) = Text
n
getSnapshots
:: ( MonadBH m
, MonadThrow m
)
=> SnapshotRepoName
-> SnapshotSelection
-> m (Either EsError [SnapshotInfo])
getSnapshots :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
SnapshotRepoName
-> SnapshotSelection -> m (Either EsError [SnapshotInfo])
getSnapshots (SnapshotRepoName Text
repoName) SnapshotSelection
sel =
(Either EsError SIs -> Either EsError [SnapshotInfo])
-> m (Either EsError SIs) -> m (Either EsError [SnapshotInfo])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SIs -> [SnapshotInfo])
-> Either EsError SIs -> Either EsError [SnapshotInfo]
forall a b. (a -> b) -> Either EsError a -> Either EsError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SIs -> [SnapshotInfo]
unSIs) (m (Either EsError SIs) -> m (Either EsError [SnapshotInfo]))
-> (Reply -> m (Either EsError SIs))
-> Reply
-> m (Either EsError [SnapshotInfo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply -> m (Either EsError SIs)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError [SnapshotInfo]))
-> m Reply -> m (Either EsError [SnapshotInfo])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_snapshot", Text
repoName, Text
snapPath]
snapPath :: Text
snapPath = case SnapshotSelection
sel of
SnapshotSelection
AllSnapshots -> Text
"_all"
SnapshotList (SnapshotPattern
s :| [SnapshotPattern]
ss) -> Text -> [Text] -> Text
T.intercalate Text
"," (SnapshotPattern -> Text
renderPath (SnapshotPattern -> Text) -> [SnapshotPattern] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SnapshotPattern
sSnapshotPattern -> [SnapshotPattern] -> [SnapshotPattern]
forall a. a -> [a] -> [a]
:[SnapshotPattern]
ss))
renderPath :: SnapshotPattern -> Text
renderPath (SnapPattern Text
t) = Text
t
renderPath (ExactSnap (SnapshotName Text
t)) = Text
t
newtype SIs = SIs { SIs -> [SnapshotInfo]
unSIs :: [SnapshotInfo] }
instance FromJSON SIs where
parseJSON :: Value -> Parser SIs
parseJSON = [Char] -> (Object -> Parser SIs) -> Value -> Parser SIs
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Collection of SnapshotInfo" Object -> Parser SIs
parse
where
parse :: Object -> Parser SIs
parse Object
o = [SnapshotInfo] -> SIs
SIs ([SnapshotInfo] -> SIs) -> Parser [SnapshotInfo] -> Parser SIs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [SnapshotInfo]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"snapshots"
deleteSnapshot :: MonadBH m => SnapshotRepoName -> SnapshotName -> m Reply
deleteSnapshot :: forall (m :: * -> *).
MonadBH m =>
SnapshotRepoName -> SnapshotName -> m Reply
deleteSnapshot (SnapshotRepoName Text
repoName) (SnapshotName Text
snapName) =
Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
delete (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_snapshot", Text
repoName, Text
snapName]
restoreSnapshot
:: MonadBH m
=> SnapshotRepoName
-> SnapshotName
-> SnapshotRestoreSettings
-> m Reply
restoreSnapshot :: forall (m :: * -> *).
MonadBH m =>
SnapshotRepoName
-> SnapshotName -> SnapshotRestoreSettings -> m Reply
restoreSnapshot (SnapshotRepoName Text
repoName)
(SnapshotName Text
snapName)
SnapshotRestoreSettings {Bool
Maybe (NonEmpty Text)
Maybe (NonEmpty RestoreRenameToken)
Maybe RestoreIndexSettings
Maybe RestoreRenamePattern
Maybe IndexSelection
snapRestoreWaitForCompletion :: Bool
snapRestoreIndices :: Maybe IndexSelection
snapRestoreIgnoreUnavailable :: Bool
snapRestoreIncludeGlobalState :: Bool
snapRestoreRenamePattern :: Maybe RestoreRenamePattern
snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
snapRestorePartial :: Bool
snapRestoreIncludeAliases :: Bool
snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
snapRestoreWaitForCompletion :: SnapshotRestoreSettings -> Bool
snapRestoreIndices :: SnapshotRestoreSettings -> Maybe IndexSelection
snapRestoreIgnoreUnavailable :: SnapshotRestoreSettings -> Bool
snapRestoreIncludeGlobalState :: SnapshotRestoreSettings -> Bool
snapRestoreRenamePattern :: SnapshotRestoreSettings -> Maybe RestoreRenamePattern
snapRestoreRenameReplacement :: SnapshotRestoreSettings -> Maybe (NonEmpty RestoreRenameToken)
snapRestorePartial :: SnapshotRestoreSettings -> Bool
snapRestoreIncludeAliases :: SnapshotRestoreSettings -> Bool
snapRestoreIndexSettingsOverrides :: SnapshotRestoreSettings -> Maybe RestoreIndexSettings
snapRestoreIgnoreIndexSettings :: SnapshotRestoreSettings -> Maybe (NonEmpty Text)
..} = (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
body))
where
url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_snapshot", Text
repoName, Text
snapName, Text
"_restore"]
params :: [(Text, Maybe Text)]
params = [(Text
"wait_for_completion", Text -> Maybe Text
forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
snapRestoreWaitForCompletion))]
body :: ByteString
body = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([Pair] -> Value
object [Pair]
prs)
prs :: [Pair]
prs = [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [ (Key
"indices" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) (Text -> Pair)
-> (IndexSelection -> Text) -> IndexSelection -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexSelection -> Text
indexSelectionName (IndexSelection -> Pair) -> Maybe IndexSelection -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe IndexSelection
snapRestoreIndices
, Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"ignore_unavailable" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
snapRestoreIgnoreUnavailable)
, Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"include_global_state" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
snapRestoreIncludeGlobalState)
, (Key
"rename_pattern" Key -> RestoreRenamePattern -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) (RestoreRenamePattern -> Pair)
-> Maybe RestoreRenamePattern -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RestoreRenamePattern
snapRestoreRenamePattern
, (Key
"rename_replacement" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) (Text -> Pair)
-> (NonEmpty RestoreRenameToken -> Text)
-> NonEmpty RestoreRenameToken
-> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty RestoreRenameToken -> Text
renderTokens (NonEmpty RestoreRenameToken -> Pair)
-> Maybe (NonEmpty RestoreRenameToken) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty RestoreRenameToken)
snapRestoreRenameReplacement
, Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"include_aliases" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
snapRestoreIncludeAliases)
, (Key
"index_settings" Key -> RestoreIndexSettings -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ) (RestoreIndexSettings -> Pair)
-> Maybe RestoreIndexSettings -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RestoreIndexSettings
snapRestoreIndexSettingsOverrides
, (Key
"ignore_index_settings" Key -> NonEmpty Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ) (NonEmpty Text -> Pair) -> Maybe (NonEmpty Text) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty Text)
snapRestoreIgnoreIndexSettings
]
renderTokens :: NonEmpty RestoreRenameToken -> Text
renderTokens (RestoreRenameToken
t :| [RestoreRenameToken]
ts) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (RestoreRenameToken -> Text
renderToken (RestoreRenameToken -> Text) -> [RestoreRenameToken] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RestoreRenameToken
tRestoreRenameToken -> [RestoreRenameToken] -> [RestoreRenameToken]
forall a. a -> [a] -> [a]
:[RestoreRenameToken]
ts))
renderToken :: RestoreRenameToken -> Text
renderToken (RRTLit Text
t) = Text
t
renderToken RestoreRenameToken
RRSubWholeMatch = Text
"$0"
renderToken (RRSubGroup RRGroupRefNum
g) = [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show (RRGroupRefNum -> Int
rrGroupRefNum RRGroupRefNum
g))
getNodesInfo
:: ( MonadBH m
, MonadThrow m
)
=> NodeSelection
-> m (Either EsError NodesInfo)
getNodesInfo :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
NodeSelection -> m (Either EsError NodesInfo)
getNodesInfo NodeSelection
sel = Reply -> m (Either EsError NodesInfo)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError NodesInfo))
-> m Reply -> m (Either EsError NodesInfo)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_nodes", Text
selectionSeg]
selectionSeg :: Text
selectionSeg = case NodeSelection
sel of
NodeSelection
LocalNode -> Text
"_local"
NodeList (NodeSelector
l :| [NodeSelector]
ls) -> Text -> [Text] -> Text
T.intercalate Text
"," (NodeSelector -> Text
selToSeg (NodeSelector -> Text) -> [NodeSelector] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NodeSelector
lNodeSelector -> [NodeSelector] -> [NodeSelector]
forall a. a -> [a] -> [a]
:[NodeSelector]
ls))
NodeSelection
AllNodes -> Text
"_all"
selToSeg :: NodeSelector -> Text
selToSeg (NodeByName (NodeName Text
n)) = Text
n
selToSeg (NodeByFullNodeId (FullNodeId Text
i)) = Text
i
selToSeg (NodeByHost (Server Text
s)) = Text
s
selToSeg (NodeByAttribute (NodeAttrName Text
a) Text
v) = Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v
getNodesStats
:: ( MonadBH m
, MonadThrow m
)
=> NodeSelection
-> m (Either EsError NodesStats)
getNodesStats :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
NodeSelection -> m (Either EsError NodesStats)
getNodesStats NodeSelection
sel = Reply -> m (Either EsError NodesStats)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError NodesStats))
-> m Reply -> m (Either EsError NodesStats)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_nodes", Text
selectionSeg, Text
"stats"]
selectionSeg :: Text
selectionSeg = case NodeSelection
sel of
NodeSelection
LocalNode -> Text
"_local"
NodeList (NodeSelector
l :| [NodeSelector]
ls) -> Text -> [Text] -> Text
T.intercalate Text
"," (NodeSelector -> Text
selToSeg (NodeSelector -> Text) -> [NodeSelector] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NodeSelector
lNodeSelector -> [NodeSelector] -> [NodeSelector]
forall a. a -> [a] -> [a]
:[NodeSelector]
ls))
NodeSelection
AllNodes -> Text
"_all"
selToSeg :: NodeSelector -> Text
selToSeg (NodeByName (NodeName Text
n)) = Text
n
selToSeg (NodeByFullNodeId (FullNodeId Text
i)) = Text
i
selToSeg (NodeByHost (Server Text
s)) = Text
s
selToSeg (NodeByAttribute (NodeAttrName Text
a) Text
v) = Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v
createIndex :: MonadBH m => IndexSettings -> IndexName -> m Reply
createIndex :: forall (m :: * -> *).
MonadBH m =>
IndexSettings -> IndexName -> m Reply
createIndex IndexSettings
indexSettings (IndexName Text
indexName) =
(Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName]
body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ IndexSettings -> ByteString
forall a. ToJSON a => a -> ByteString
encode IndexSettings
indexSettings
createIndexWith :: MonadBH m
=> [UpdatableIndexSetting]
-> Int
-> IndexName
-> m Reply
createIndexWith :: forall (m :: * -> *).
MonadBH m =>
[UpdatableIndexSetting] -> Int -> IndexName -> m Reply
createIndexWith [UpdatableIndexSetting]
updates Int
shards (IndexName Text
indexName) =
(Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
body))
where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName]
body :: ByteString
body = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
[Key
"settings" Key -> Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Object] -> Object
deepMerge
( Key -> Value -> Object
forall v. Key -> v -> KeyMap v
KeyMap.singleton Key
"index.number_of_shards" (Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
shards) Object -> [Object] -> [Object]
forall a. a -> [a] -> [a]
:
[Object
u | Object Object
u <- UpdatableIndexSetting -> Value
forall a. ToJSON a => a -> Value
toJSON (UpdatableIndexSetting -> Value)
-> [UpdatableIndexSetting] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UpdatableIndexSetting]
updates]
)
]
flushIndex :: MonadBH m => IndexName -> m Reply
flushIndex :: forall (m :: * -> *). MonadBH m => IndexName -> m Reply
flushIndex (IndexName Text
indexName) = do
Text
path <- [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_flush"]
Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post Text
path Maybe ByteString
forall a. Maybe a
Nothing
deleteIndex :: MonadBH m => IndexName -> m Reply
deleteIndex :: forall (m :: * -> *). MonadBH m => IndexName -> m Reply
deleteIndex (IndexName Text
indexName) =
Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
delete (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName]
updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
updateIndexSettings :: forall (m :: * -> *).
MonadBH m =>
NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
updateIndexSettings NonEmpty UpdatableIndexSetting
updates (IndexName Text
indexName) =
(Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_settings"]
body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
jsonBody)
jsonBody :: Value
jsonBody = Object -> Value
Object ([Object] -> Object
deepMerge [Object
u | Object Object
u <- UpdatableIndexSetting -> Value
forall a. ToJSON a => a -> Value
toJSON (UpdatableIndexSetting -> Value)
-> [UpdatableIndexSetting] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty UpdatableIndexSetting -> [UpdatableIndexSetting]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty UpdatableIndexSetting
updates])
getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
-> m (Either EsError IndexSettingsSummary)
getIndexSettings :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
IndexName -> m (Either EsError IndexSettingsSummary)
getIndexSettings (IndexName Text
indexName) =
Reply -> m (Either EsError IndexSettingsSummary)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError IndexSettingsSummary))
-> m Reply -> m (Either EsError IndexSettingsSummary)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_settings"]
forceMergeIndex :: MonadBH m => IndexSelection -> ForceMergeIndexSettings -> m Reply
forceMergeIndex :: forall (m :: * -> *).
MonadBH m =>
IndexSelection -> ForceMergeIndexSettings -> m Reply
forceMergeIndex IndexSelection
ixs ForceMergeIndexSettings {Bool
Maybe Int
maxNumSegments :: Maybe Int
onlyExpungeDeletes :: Bool
flushAfterOptimize :: Bool
maxNumSegments :: ForceMergeIndexSettings -> Maybe Int
onlyExpungeDeletes :: ForceMergeIndexSettings -> Bool
flushAfterOptimize :: ForceMergeIndexSettings -> Bool
..} =
(Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
body)
where url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_forcemerge"]
params :: [(Text, Maybe Text)]
params = [Maybe (Text, Maybe Text)] -> [(Text, Maybe Text)]
forall a. [Maybe a] -> [a]
catMaybes [ (Text
"max_num_segments",) (Maybe Text -> (Text, Maybe Text))
-> (Int -> Maybe Text) -> Int -> (Text, Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Int -> Text) -> Int -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall a. Show a => a -> Text
showText (Int -> (Text, Maybe Text))
-> Maybe Int -> Maybe (Text, Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maxNumSegments
, (Text, Maybe Text) -> Maybe (Text, Maybe Text)
forall a. a -> Maybe a
Just (Text
"only_expunge_deletes", Text -> Maybe Text
forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
onlyExpungeDeletes))
, (Text, Maybe Text) -> Maybe (Text, Maybe Text)
forall a. a -> Maybe a
Just (Text
"flush", Text -> Maybe Text
forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
flushAfterOptimize))
]
indexName :: Text
indexName = IndexSelection -> Text
indexSelectionName IndexSelection
ixs
body :: Maybe a
body = Maybe a
forall a. Maybe a
Nothing
deepMerge :: [Object] -> Object
deepMerge :: [Object] -> Object
deepMerge = (Object -> Object -> Object) -> Object -> [Object] -> Object
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
LS.foldl' Object -> Object -> Object
go Object
forall a. Monoid a => a
mempty
where go :: Object -> Object -> Object
go Object
acc = (Object -> Pair -> Object) -> Object -> [Pair] -> Object
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
LS.foldl' Object -> Pair -> Object
go' Object
acc ([Pair] -> Object) -> (Object -> [Pair]) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList
go' :: Object -> Pair -> Object
go' Object
acc (Key
k, Value
v) = (Value -> Value -> Value) -> Key -> Value -> Object -> Object
forall a. (a -> a -> a) -> Key -> a -> KeyMap a -> KeyMap a
insertWith Value -> Value -> Value
merge Key
k Value
v Object
acc
merge :: Value -> Value -> Value
merge (Object Object
a) (Object Object
b) = Object -> Value
Object ([Object] -> Object
deepMerge [Object
a, Object
b])
merge Value
_ Value
b = Value
b
insertWith :: (a -> a -> a) -> Key -> a -> KeyMap.KeyMap a -> KeyMap.KeyMap a
insertWith :: forall a. (a -> a -> a) -> Key -> a -> KeyMap a -> KeyMap a
insertWith a -> a -> a
f Key
k a
new KeyMap a
m = Identity (KeyMap a) -> KeyMap a
forall a. Identity a -> a
runIdentity (Identity (KeyMap a) -> KeyMap a)
-> Identity (KeyMap a) -> KeyMap a
forall a b. (a -> b) -> a -> b
$ (Maybe a -> Identity (Maybe a))
-> Key -> KeyMap a -> Identity (KeyMap a)
forall (f :: * -> *) v.
Functor f =>
(Maybe v -> f (Maybe v)) -> Key -> KeyMap v -> f (KeyMap v)
KeyMap.alterF Maybe a -> Identity (Maybe a)
forall {f :: * -> *}. Applicative f => Maybe a -> f (Maybe a)
merge Key
k KeyMap a
m
where merge :: Maybe a -> f (Maybe a)
merge Maybe a
Nothing = Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> f (Maybe a)) -> Maybe a -> f (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
new
merge (Just a
old) = Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> f (Maybe a)) -> (a -> Maybe a) -> a -> f (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> f (Maybe a)) -> a -> f (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> a -> a
f a
old a
new
statusCodeIs :: (Int, Int) -> Reply -> Bool
statusCodeIs :: (Int, Int) -> Reply -> Bool
statusCodeIs (Int, Int)
r Reply
resp = (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int, Int)
r (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ Status -> Int
NHTS.statusCode (Reply -> Status
forall body. Response body -> Status
responseStatus Reply
resp)
respIsTwoHunna :: Reply -> Bool
respIsTwoHunna :: Reply -> Bool
respIsTwoHunna = (Int, Int) -> Reply -> Bool
statusCodeIs (Int
200, Int
299)
existentialQuery :: MonadBH m => Text -> m (Reply, Bool)
existentialQuery :: forall (m :: * -> *). MonadBH m => Text -> m (Reply, Bool)
existentialQuery Text
url = do
Reply
reply <- Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
head Text
url
(Reply, Bool) -> m (Reply, Bool)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reply
reply, Reply -> Bool
respIsTwoHunna Reply
reply)
parseEsResponse :: ( MonadThrow m
, FromJSON a
)
=> Reply
-> m (Either EsError a)
parseEsResponse :: forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse Reply
reply
| Reply -> Bool
respIsTwoHunna Reply
reply = case ByteString -> Either [Char] a
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
body of
Right a
a -> Either EsError a -> m (Either EsError a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either EsError a
forall a b. b -> Either a b
Right a
a)
Left [Char]
err ->
[Char] -> m (Either EsError a)
forall {a} {m :: * -> *} {b}.
(FromJSON a, MonadThrow m) =>
[Char] -> m (Either a b)
tryParseError [Char]
err
| Bool
otherwise = [Char] -> m (Either EsError a)
forall {a} {m :: * -> *} {b}.
(FromJSON a, MonadThrow m) =>
[Char] -> m (Either a b)
tryParseError [Char]
"Non-200 status code"
where body :: ByteString
body = Reply -> ByteString
forall body. Response body -> body
responseBody Reply
reply
tryParseError :: [Char] -> m (Either a b)
tryParseError [Char]
originalError
= case ByteString -> Either [Char] a
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
body of
Right a
e -> Either a b -> m (Either a b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either a b
forall a b. a -> Either a b
Left a
e)
Left [Char]
err -> [Char] -> m (Either a b)
forall {m :: * -> *} {a}. MonadThrow m => [Char] -> m a
explode ([Char]
"Original error was: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
originalError [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" Error parse failure was: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
err)
explode :: [Char] -> m a
explode [Char]
errorMsg = EsProtocolException -> m a
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (Text -> ByteString -> EsProtocolException
EsProtocolException ([Char] -> Text
T.pack [Char]
errorMsg) ByteString
body)
indexExists :: MonadBH m => IndexName -> m Bool
indexExists :: forall (m :: * -> *). MonadBH m => IndexName -> m Bool
indexExists (IndexName Text
indexName) = do
(Reply
_, Bool
exists) <- Text -> m (Reply, Bool)
forall (m :: * -> *). MonadBH m => Text -> m (Reply, Bool)
existentialQuery (Text -> m (Reply, Bool)) -> m Text -> m (Reply, Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName]
Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exists
refreshIndex :: MonadBH m => IndexName -> m Reply
refreshIndex :: forall (m :: * -> *). MonadBH m => IndexName -> m Reply
refreshIndex (IndexName Text
indexName) =
(Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing)
where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_refresh"]
waitForYellowIndex :: MonadBH m => IndexName -> m Reply
waitForYellowIndex :: forall (m :: * -> *). MonadBH m => IndexName -> m Reply
waitForYellowIndex (IndexName Text
indexName) = Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
where url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
q (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_cluster",Text
"health",Text
indexName]
q :: [(Text, Maybe Text)]
q = [(Text
"wait_for_status",Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"yellow"),(Text
"timeout",Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"10s")]
stringifyOCIndex :: OpenCloseIndex -> Text
stringifyOCIndex :: OpenCloseIndex -> Text
stringifyOCIndex OpenCloseIndex
oci = case OpenCloseIndex
oci of
OpenCloseIndex
OpenIndex -> Text
"_open"
OpenCloseIndex
CloseIndex -> Text
"_close"
openOrCloseIndexes :: MonadBH m => OpenCloseIndex -> IndexName -> m Reply
openOrCloseIndexes :: forall (m :: * -> *).
MonadBH m =>
OpenCloseIndex -> IndexName -> m Reply
openOrCloseIndexes OpenCloseIndex
oci (IndexName Text
indexName) =
(Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing)
where ociString :: Text
ociString = OpenCloseIndex -> Text
stringifyOCIndex OpenCloseIndex
oci
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
ociString]
openIndex :: MonadBH m => IndexName -> m Reply
openIndex :: forall (m :: * -> *). MonadBH m => IndexName -> m Reply
openIndex = OpenCloseIndex -> IndexName -> m Reply
forall (m :: * -> *).
MonadBH m =>
OpenCloseIndex -> IndexName -> m Reply
openOrCloseIndexes OpenCloseIndex
OpenIndex
closeIndex :: MonadBH m => IndexName -> m Reply
closeIndex :: forall (m :: * -> *). MonadBH m => IndexName -> m Reply
closeIndex = OpenCloseIndex -> IndexName -> m Reply
forall (m :: * -> *).
MonadBH m =>
OpenCloseIndex -> IndexName -> m Reply
openOrCloseIndexes OpenCloseIndex
CloseIndex
listIndices :: (MonadThrow m, MonadBH m) => m [IndexName]
listIndices :: forall (m :: * -> *). (MonadThrow m, MonadBH m) => m [IndexName]
listIndices =
ByteString -> m [IndexName]
forall {m :: * -> *} {t :: * -> *}.
(MonadThrow m, FromJSON (t Value), Traversable t) =>
ByteString -> m (t IndexName)
parse (ByteString -> m [IndexName])
-> (Reply -> ByteString) -> Reply -> m [IndexName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply -> ByteString
forall body. Response body -> body
responseBody (Reply -> m [IndexName]) -> m Reply -> m [IndexName]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_cat/indices?format=json"]
parse :: ByteString -> m (t IndexName)
parse ByteString
body = ([Char] -> m (t IndexName))
-> (t IndexName -> m (t IndexName))
-> Either [Char] (t IndexName)
-> m (t IndexName)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\[Char]
msg -> (EsProtocolException -> m (t IndexName)
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (Text -> ByteString -> EsProtocolException
EsProtocolException ([Char] -> Text
T.pack [Char]
msg) ByteString
body))) t IndexName -> m (t IndexName)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] (t IndexName) -> m (t IndexName))
-> Either [Char] (t IndexName) -> m (t IndexName)
forall a b. (a -> b) -> a -> b
$ do
t Value
vals <- ByteString -> Either [Char] (t Value)
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
body
t Value
-> (Value -> Either [Char] IndexName)
-> Either [Char] (t IndexName)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM t Value
vals ((Value -> Either [Char] IndexName) -> Either [Char] (t IndexName))
-> (Value -> Either [Char] IndexName)
-> Either [Char] (t IndexName)
forall a b. (a -> b) -> a -> b
$ \Value
val ->
case Value
val of
Object Object
obj ->
case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"index" Object
obj of
(Just (String Text
txt)) -> IndexName -> Either [Char] IndexName
forall a b. b -> Either a b
Right (Text -> IndexName
IndexName Text
txt)
Maybe Value
v -> [Char] -> Either [Char] IndexName
forall a b. a -> Either a b
Left ([Char] -> Either [Char] IndexName)
-> [Char] -> Either [Char] IndexName
forall a b. (a -> b) -> a -> b
$ [Char]
"indexVal in listIndices failed on non-string, was: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Maybe Value -> [Char]
forall a. Show a => a -> [Char]
show Maybe Value
v
Value
v -> [Char] -> Either [Char] IndexName
forall a b. a -> Either a b
Left ([Char] -> Either [Char] IndexName)
-> [Char] -> Either [Char] IndexName
forall a b. (a -> b) -> a -> b
$ [Char]
"One of the values parsed in listIndices wasn't an object, it was: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v
catIndices :: (MonadThrow m, MonadBH m) => m [(IndexName, Int)]
catIndices :: forall (m :: * -> *).
(MonadThrow m, MonadBH m) =>
m [(IndexName, Int)]
catIndices =
ByteString -> m [(IndexName, Int)]
forall {m :: * -> *} {t :: * -> *} {b}.
(MonadThrow m, FromJSON (t Value), Traversable t, Read b) =>
ByteString -> m (t (IndexName, b))
parse (ByteString -> m [(IndexName, Int)])
-> (Reply -> ByteString) -> Reply -> m [(IndexName, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply -> ByteString
forall body. Response body -> body
responseBody (Reply -> m [(IndexName, Int)]) -> m Reply -> m [(IndexName, Int)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_cat/indices?format=json"]
parse :: ByteString -> m (t (IndexName, b))
parse ByteString
body = ([Char] -> m (t (IndexName, b)))
-> (t (IndexName, b) -> m (t (IndexName, b)))
-> Either [Char] (t (IndexName, b))
-> m (t (IndexName, b))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\[Char]
msg -> (EsProtocolException -> m (t (IndexName, b))
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (Text -> ByteString -> EsProtocolException
EsProtocolException ([Char] -> Text
T.pack [Char]
msg) ByteString
body))) t (IndexName, b) -> m (t (IndexName, b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] (t (IndexName, b)) -> m (t (IndexName, b)))
-> Either [Char] (t (IndexName, b)) -> m (t (IndexName, b))
forall a b. (a -> b) -> a -> b
$ do
t Value
vals <- ByteString -> Either [Char] (t Value)
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
body
t Value
-> (Value -> Either [Char] (IndexName, b))
-> Either [Char] (t (IndexName, b))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM t Value
vals ((Value -> Either [Char] (IndexName, b))
-> Either [Char] (t (IndexName, b)))
-> (Value -> Either [Char] (IndexName, b))
-> Either [Char] (t (IndexName, b))
forall a b. (a -> b) -> a -> b
$ \Value
val ->
case Value
val of
Object Object
obj ->
case (Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"index" Object
obj, Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"docs.count" Object
obj) of
(Just (String Text
txt), Just (String Text
docs)) -> (IndexName, b) -> Either [Char] (IndexName, b)
forall a b. b -> Either a b
Right ((Text -> IndexName
IndexName Text
txt), [Char] -> b
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
docs))
(Maybe Value, Maybe Value)
v -> [Char] -> Either [Char] (IndexName, b)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (IndexName, b))
-> [Char] -> Either [Char] (IndexName, b)
forall a b. (a -> b) -> a -> b
$ [Char]
"indexVal in catIndices failed on non-string, was: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Maybe Value, Maybe Value) -> [Char]
forall a. Show a => a -> [Char]
show (Maybe Value, Maybe Value)
v
Value
v -> [Char] -> Either [Char] (IndexName, b)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (IndexName, b))
-> [Char] -> Either [Char] (IndexName, b)
forall a b. (a -> b) -> a -> b
$ [Char]
"One of the values parsed in catIndices wasn't an object, it was: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v
updateIndexAliases :: MonadBH m => NonEmpty IndexAliasAction -> m Reply
updateIndexAliases :: forall (m :: * -> *).
MonadBH m =>
NonEmpty IndexAliasAction -> m Reply
updateIndexAliases NonEmpty IndexAliasAction
actions = (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_aliases"]
body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
bodyJSON)
bodyJSON :: Value
bodyJSON = [Pair] -> Value
object [ Key
"actions" Key -> [IndexAliasAction] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= NonEmpty IndexAliasAction -> [IndexAliasAction]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexAliasAction
actions]
getIndexAliases :: (MonadBH m, MonadThrow m)
=> m (Either EsError IndexAliasesSummary)
getIndexAliases :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
m (Either EsError IndexAliasesSummary)
getIndexAliases = Reply -> m (Either EsError IndexAliasesSummary)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError IndexAliasesSummary))
-> m Reply -> m (Either EsError IndexAliasesSummary)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_aliases"]
deleteIndexAlias :: MonadBH m => IndexAliasName -> m Reply
deleteIndexAlias :: forall (m :: * -> *). MonadBH m => IndexAliasName -> m Reply
deleteIndexAlias (IndexAliasName (IndexName Text
name)) = Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
delete (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_all",Text
"_alias",Text
name]
putTemplate :: MonadBH m => IndexTemplate -> TemplateName -> m Reply
putTemplate :: forall (m :: * -> *).
MonadBH m =>
IndexTemplate -> TemplateName -> m Reply
putTemplate IndexTemplate
indexTemplate (TemplateName Text
templateName) =
(Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_template", Text
templateName]
body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ IndexTemplate -> ByteString
forall a. ToJSON a => a -> ByteString
encode IndexTemplate
indexTemplate
templateExists :: MonadBH m => TemplateName -> m Bool
templateExists :: forall (m :: * -> *). MonadBH m => TemplateName -> m Bool
templateExists (TemplateName Text
templateName) = do
(Reply
_, Bool
exists) <- Text -> m (Reply, Bool)
forall (m :: * -> *). MonadBH m => Text -> m (Reply, Bool)
existentialQuery (Text -> m (Reply, Bool)) -> m Text -> m (Reply, Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_template", Text
templateName]
Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exists
deleteTemplate :: MonadBH m => TemplateName -> m Reply
deleteTemplate :: forall (m :: * -> *). MonadBH m => TemplateName -> m Reply
deleteTemplate (TemplateName Text
templateName) =
Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
delete (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_template", Text
templateName]
putMapping :: (MonadBH m, ToJSON a) => IndexName
-> MappingName -> a -> m Reply
putMapping :: forall (m :: * -> *) a.
(MonadBH m, ToJSON a) =>
IndexName -> MappingName -> a -> m Reply
putMapping (IndexName Text
indexName) (MappingName Text
mappingName) a
mapping =
(Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_mapping", Text
mappingName]
body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
mapping
versionCtlParams :: IndexDocumentSettings -> [(Text, Maybe Text)]
versionCtlParams :: IndexDocumentSettings -> [(Text, Maybe Text)]
versionCtlParams IndexDocumentSettings
cfg =
case IndexDocumentSettings -> VersionControl
idsVersionControl IndexDocumentSettings
cfg of
VersionControl
NoVersionControl -> []
InternalVersion DocVersion
v -> DocVersion -> Text -> [(Text, Maybe Text)]
forall {a}. IsString a => DocVersion -> Text -> [(a, Maybe Text)]
versionParams DocVersion
v Text
"internal"
ExternalGT (ExternalDocVersion DocVersion
v) -> DocVersion -> Text -> [(Text, Maybe Text)]
forall {a}. IsString a => DocVersion -> Text -> [(a, Maybe Text)]
versionParams DocVersion
v Text
"external_gt"
ExternalGTE (ExternalDocVersion DocVersion
v) -> DocVersion -> Text -> [(Text, Maybe Text)]
forall {a}. IsString a => DocVersion -> Text -> [(a, Maybe Text)]
versionParams DocVersion
v Text
"external_gte"
ForceVersion (ExternalDocVersion DocVersion
v) -> DocVersion -> Text -> [(Text, Maybe Text)]
forall {a}. IsString a => DocVersion -> Text -> [(a, Maybe Text)]
versionParams DocVersion
v Text
"force"
where
vt :: DocVersion -> Text
vt = Int -> Text
forall a. Show a => a -> Text
showText (Int -> Text) -> (DocVersion -> Int) -> DocVersion -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocVersion -> Int
docVersionNumber
versionParams :: DocVersion -> Text -> [(a, Maybe Text)]
versionParams DocVersion
v Text
t = [ (a
"version", Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ DocVersion -> Text
vt DocVersion
v)
, (a
"version_type", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t)
]
indexDocument :: (ToJSON doc, MonadBH m) => IndexName -> MappingName
-> IndexDocumentSettings -> doc -> DocId -> m Reply
indexDocument :: forall doc (m :: * -> *).
(ToJSON doc, MonadBH m) =>
IndexName
-> MappingName -> IndexDocumentSettings -> doc -> DocId -> m Reply
indexDocument (IndexName Text
indexName)
(MappingName Text
mappingName) IndexDocumentSettings
cfg doc
document (DocId Text
docId) =
(Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
where url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
mappingName, Text
docId]
parentParams :: [(Text, Maybe Text)]
parentParams = case IndexDocumentSettings -> Maybe DocumentParent
idsParent IndexDocumentSettings
cfg of
Maybe DocumentParent
Nothing -> []
Just (DocumentParent (DocId Text
p)) -> [ (Text
"parent", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
p) ]
params :: [(Text, Maybe Text)]
params = IndexDocumentSettings -> [(Text, Maybe Text)]
versionCtlParams IndexDocumentSettings
cfg [(Text, Maybe Text)]
-> [(Text, Maybe Text)] -> [(Text, Maybe Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Maybe Text)]
parentParams
body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (doc -> ByteString
forall a. ToJSON a => a -> ByteString
encode doc
document)
updateDocument :: (ToJSON patch, MonadBH m) => IndexName -> MappingName
-> IndexDocumentSettings -> patch -> DocId -> m Reply
updateDocument :: forall doc (m :: * -> *).
(ToJSON doc, MonadBH m) =>
IndexName
-> MappingName -> IndexDocumentSettings -> doc -> DocId -> m Reply
updateDocument (IndexName Text
indexName)
(MappingName Text
mappingName) IndexDocumentSettings
cfg patch
patch (DocId Text
docId) =
(Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
where url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery (IndexDocumentSettings -> [(Text, Maybe Text)]
versionCtlParams IndexDocumentSettings
cfg) (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
[Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
mappingName, Text
docId, Text
"_update"]
body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Key
"doc" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= patch -> Value
forall a. ToJSON a => a -> Value
toJSON patch
patch])
updateByQuery :: MonadBH m => IndexName -> Query -> Maybe Script -> m Reply
updateByQuery :: forall (m :: * -> *).
MonadBH m =>
IndexName -> Query -> Maybe Script -> m Reply
updateByQuery (IndexName Text
indexName) Query
q Maybe Script
mScript =
(Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_update_by_query"]
body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Object -> ByteString) -> Object -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Object -> Maybe ByteString) -> Object -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Key
"query" Key -> Query -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Object
.= Query
q) Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
scriptObject
scriptObject :: Object
scriptObject = case Maybe Script -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Script
mScript of
Value
Null -> Object
forall a. Monoid a => a
mempty
Object Object
o -> Object
o
Value
j -> Key
"script" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Object
.= Value
j
deleteDocument :: MonadBH m => IndexName -> MappingName
-> DocId -> m Reply
deleteDocument :: forall (m :: * -> *).
MonadBH m =>
IndexName -> MappingName -> DocId -> m Reply
deleteDocument (IndexName Text
indexName)
(MappingName Text
mappingName) (DocId Text
docId) =
Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
delete (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
mappingName, Text
docId]
deleteByQuery :: MonadBH m => IndexName -> MappingName -> Query -> m Reply
deleteByQuery :: forall (m :: * -> *).
MonadBH m =>
IndexName -> MappingName -> Query -> m Reply
deleteByQuery (IndexName Text
indexName) (MappingName Text
mappingName) Query
query =
(Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
mappingName, Text
"_delete_by_query"]
body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [ Key
"query" Key -> Query -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Query
query ])
bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
bulk :: forall (m :: * -> *). MonadBH m => Vector BulkOperation -> m Reply
bulk Vector BulkOperation
bulkOps =
(Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_bulk"]
body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Vector BulkOperation -> ByteString
encodeBulkOperations Vector BulkOperation
bulkOps
encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
encodeBulkOperations :: Vector BulkOperation -> ByteString
encodeBulkOperations Vector BulkOperation
stream = ByteString
collapsed where
blobs :: Vector ByteString
blobs =
(BulkOperation -> ByteString)
-> Vector BulkOperation -> Vector ByteString
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BulkOperation -> ByteString
encodeBulkOperation Vector BulkOperation
stream
mashedTaters :: Builder
mashedTaters =
Builder -> Vector ByteString -> Builder
mash (Builder
forall a. Monoid a => a
mempty :: Builder) Vector ByteString
blobs
collapsed :: ByteString
collapsed =
Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend Builder
mashedTaters (ByteString -> Builder
byteString ByteString
"\n")
mash :: Builder -> V.Vector L.ByteString -> Builder
mash :: Builder -> Vector ByteString -> Builder
mash = (Builder -> ByteString -> Builder)
-> Builder -> Vector ByteString -> Builder
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' (\Builder
b ByteString
x -> Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
lazyByteString ByteString
x)
mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
mkBulkStreamValue Text
operation Text
indexName Text
mappingName Text
docId =
[Pair] -> Value
object [Text -> Key
Key.fromText Text
operation Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
[Pair] -> Value
object [ Key
"_index" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
indexName
, Key
"_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
mappingName
, Key
"_id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
docId]]
mkBulkStreamValueAuto :: Text -> Text -> Text -> Value
mkBulkStreamValueAuto :: Text -> Text -> Text -> Value
mkBulkStreamValueAuto Text
operation Text
indexName Text
mappingName =
[Pair] -> Value
object [Text -> Key
Key.fromText Text
operation Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
[Pair] -> Value
object [ Key
"_index" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
indexName
, Key
"_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
mappingName]]
mkBulkStreamValueWithMeta :: [UpsertActionMetadata] -> Text -> Text -> Text -> Text -> Value
mkBulkStreamValueWithMeta :: [UpsertActionMetadata] -> Text -> Text -> Text -> Text -> Value
mkBulkStreamValueWithMeta [UpsertActionMetadata]
meta Text
operation Text
indexName Text
mappingName Text
docId =
[Pair] -> Value
object [ Text -> Key
Key.fromText Text
operation Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
[Pair] -> Value
object ([ Key
"_index" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
indexName
, Key
"_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
mappingName
, Key
"_id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
docId]
[Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> (UpsertActionMetadata -> Pair
buildUpsertActionMetadata (UpsertActionMetadata -> Pair) -> [UpsertActionMetadata] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UpsertActionMetadata]
meta))]
encodeBulkOperation :: BulkOperation -> L.ByteString
encodeBulkOperation :: BulkOperation -> ByteString
encodeBulkOperation (BulkIndex (IndexName Text
indexName)
(MappingName Text
mappingName)
(DocId Text
docId) Value
value) = ByteString
blob
where metadata :: Value
metadata = Text -> Text -> Text -> Text -> Value
mkBulkStreamValue Text
"index" Text
indexName Text
mappingName Text
docId
blob :: ByteString
blob = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
metadata ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
value
encodeBulkOperation (BulkIndexAuto (IndexName Text
indexName)
(MappingName Text
mappingName)
Value
value) = ByteString
blob
where metadata :: Value
metadata = Text -> Text -> Text -> Value
mkBulkStreamValueAuto Text
"index" Text
indexName Text
mappingName
blob :: ByteString
blob = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
metadata ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
value
encodeBulkOperation (BulkIndexEncodingAuto (IndexName Text
indexName)
(MappingName Text
mappingName)
Encoding
encoding) = Builder -> ByteString
toLazyByteString Builder
blob
where metadata :: Encoding
metadata = Value -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Text -> Text -> Value
mkBulkStreamValueAuto Text
"index" Text
indexName Text
mappingName)
blob :: Builder
blob = Encoding -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding Encoding
metadata Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Encoding -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding Encoding
encoding
encodeBulkOperation (BulkCreate (IndexName Text
indexName)
(MappingName Text
mappingName)
(DocId Text
docId) Value
value) = ByteString
blob
where metadata :: Value
metadata = Text -> Text -> Text -> Text -> Value
mkBulkStreamValue Text
"create" Text
indexName Text
mappingName Text
docId
blob :: ByteString
blob = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
metadata ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
value
encodeBulkOperation (BulkDelete (IndexName Text
indexName)
(MappingName Text
mappingName)
(DocId Text
docId)) = ByteString
blob
where metadata :: Value
metadata = Text -> Text -> Text -> Text -> Value
mkBulkStreamValue Text
"delete" Text
indexName Text
mappingName Text
docId
blob :: ByteString
blob = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
metadata
encodeBulkOperation (BulkUpdate (IndexName Text
indexName)
(MappingName Text
mappingName)
(DocId Text
docId) Value
value) = ByteString
blob
where metadata :: Value
metadata = Text -> Text -> Text -> Text -> Value
mkBulkStreamValue Text
"update" Text
indexName Text
mappingName Text
docId
doc :: Value
doc = [Pair] -> Value
object [Key
"doc" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Value
value]
blob :: ByteString
blob = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
metadata ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
doc
encodeBulkOperation (BulkUpsert (IndexName Text
indexName)
(MappingName Text
mappingName)
(DocId Text
docId)
UpsertPayload
payload
[UpsertActionMetadata]
actionMeta) = ByteString
blob
where metadata :: Value
metadata = [UpsertActionMetadata] -> Text -> Text -> Text -> Text -> Value
mkBulkStreamValueWithMeta [UpsertActionMetadata]
actionMeta Text
"update" Text
indexName Text
mappingName Text
docId
blob :: ByteString
blob = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
metadata ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
doc
doc :: Value
doc = case UpsertPayload
payload of
UpsertDoc Value
value -> [Pair] -> Value
object [Key
"doc" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Value
value, Key
"doc_as_upsert" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
True]
UpsertScript Bool
scriptedUpsert Script
script Value
value ->
let scup :: [Pair]
scup = if Bool
scriptedUpsert then [Key
"scripted_upsert" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
True] else []
upsert :: [Pair]
upsert = [Key
"upsert" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Value
value]
in
case ([Pair] -> Value
object ([Pair]
scup [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
upsert), Script -> Value
forall a. ToJSON a => a -> Value
toJSON Script
script) of
(Object Object
obj, Object Object
jscript) -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Object
jscript Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
obj
(Value, Value)
_ -> [Char] -> Value
forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible happened: serialising Script to Json should always be Object"
encodeBulkOperation (BulkCreateEncoding (IndexName Text
indexName)
(MappingName Text
mappingName)
(DocId Text
docId) Encoding
encoding) = Builder -> ByteString
toLazyByteString Builder
blob
where metadata :: Encoding
metadata = Value -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Text -> Text -> Text -> Value
mkBulkStreamValue Text
"create" Text
indexName Text
mappingName Text
docId)
blob :: Builder
blob = Encoding -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding Encoding
metadata Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Encoding -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding Encoding
encoding
getDocument :: MonadBH m => IndexName -> MappingName
-> DocId -> m Reply
getDocument :: forall (m :: * -> *).
MonadBH m =>
IndexName -> MappingName -> DocId -> m Reply
getDocument (IndexName Text
indexName)
(MappingName Text
mappingName) (DocId Text
docId) =
Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
mappingName, Text
docId]
documentExists :: MonadBH m => IndexName -> MappingName
-> Maybe DocumentParent -> DocId -> m Bool
documentExists :: forall (m :: * -> *).
MonadBH m =>
IndexName -> MappingName -> Maybe DocumentParent -> DocId -> m Bool
documentExists (IndexName Text
indexName) (MappingName Text
mappingName)
Maybe DocumentParent
parent (DocId Text
docId) = do
(Reply
_, Bool
exists) <- Text -> m (Reply, Bool)
forall (m :: * -> *). MonadBH m => Text -> m (Reply, Bool)
existentialQuery (Text -> m (Reply, Bool)) -> m Text -> m (Reply, Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exists
where url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
mappingName, Text
docId]
parentParam :: Maybe Text
parentParam = (DocumentParent -> Text) -> Maybe DocumentParent -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(DocumentParent (DocId Text
p)) -> Text
p) Maybe DocumentParent
parent
params :: [(Text, Maybe Text)]
params = ((Text, Maybe Text) -> Bool)
-> [(Text, Maybe Text)] -> [(Text, Maybe Text)]
forall a. (a -> Bool) -> [a] -> [a]
LS.filter (\(Text
_, Maybe Text
v) -> Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
v) [(Text
"parent", Maybe Text
parentParam)]
dispatchSearch :: MonadBH m => Text -> Search -> m Reply
dispatchSearch :: forall (m :: * -> *). MonadBH m => Text -> Search -> m Reply
dispatchSearch Text
url Search
search = Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post Text
url' (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Search -> ByteString
forall a. ToJSON a => a -> ByteString
encode Search
search))
where url' :: Text
url' = Text -> SearchType -> Text
appendSearchTypeParam Text
url (Search -> SearchType
searchType Search
search)
searchAll :: MonadBH m => Search -> m Reply
searchAll :: forall (m :: * -> *). MonadBH m => Search -> m Reply
searchAll = (Text -> Search -> m Reply) -> m Text -> m Search -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Search -> m Reply
forall (m :: * -> *). MonadBH m => Text -> Search -> m Reply
dispatchSearch m Text
url (m Search -> m Reply) -> (Search -> m Search) -> Search -> m Reply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Search -> m Search
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_search"]
searchByIndex :: MonadBH m => IndexName -> Search -> m Reply
searchByIndex :: forall (m :: * -> *). MonadBH m => IndexName -> Search -> m Reply
searchByIndex (IndexName Text
indexName) = (Text -> Search -> m Reply) -> m Text -> m Search -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Search -> m Reply
forall (m :: * -> *). MonadBH m => Text -> Search -> m Reply
dispatchSearch m Text
url (m Search -> m Reply) -> (Search -> m Search) -> Search -> m Reply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Search -> m Search
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_search"]
searchByIndices :: MonadBH m => NonEmpty IndexName -> Search -> m Reply
searchByIndices :: forall (m :: * -> *).
MonadBH m =>
NonEmpty IndexName -> Search -> m Reply
searchByIndices NonEmpty IndexName
ixs = (Text -> Search -> m Reply) -> m Text -> m Search -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Search -> m Reply
forall (m :: * -> *). MonadBH m => Text -> Search -> m Reply
dispatchSearch m Text
url (m Search -> m Reply) -> (Search -> m Search) -> Search -> m Reply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Search -> m Search
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
renderedIxs, Text
"_search"]
renderedIxs :: Text
renderedIxs = Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
',') ((IndexName -> Text) -> [IndexName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(IndexName Text
t) -> Text
t) (NonEmpty IndexName -> [IndexName]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexName
ixs))
searchByType :: MonadBH m => IndexName -> MappingName -> Search
-> m Reply
searchByType :: forall (m :: * -> *).
MonadBH m =>
IndexName -> MappingName -> Search -> m Reply
searchByType (IndexName Text
indexName)
(MappingName Text
mappingName) = (Text -> Search -> m Reply) -> m Text -> m Search -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Search -> m Reply
forall (m :: * -> *). MonadBH m => Text -> Search -> m Reply
dispatchSearch m Text
url (m Search -> m Reply) -> (Search -> m Search) -> Search -> m Reply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Search -> m Search
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
mappingName, Text
"_search"]
getInitialScroll ::
(FromJSON a, MonadThrow m, MonadBH m) => IndexName ->
MappingName ->
Search ->
m (Either EsError (SearchResult a))
getInitialScroll :: forall a (m :: * -> *).
(FromJSON a, MonadThrow m, MonadBH m) =>
IndexName
-> MappingName -> Search -> m (Either EsError (SearchResult a))
getInitialScroll (IndexName Text
indexName) (MappingName Text
mappingName) Search
search' = do
let url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
mappingName, Text
"_search"]
params :: [(Text, Maybe Text)]
params = [(Text
"scroll", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"1m")]
sorting :: Maybe [SortSpec]
sorting = [SortSpec] -> Maybe [SortSpec]
forall a. a -> Maybe a
Just [DefaultSort -> SortSpec
DefaultSortSpec (DefaultSort -> SortSpec) -> DefaultSort -> SortSpec
forall a b. (a -> b) -> a -> b
$ FieldName -> SortOrder -> DefaultSort
mkSort (Text -> FieldName
FieldName Text
"_doc") SortOrder
Descending]
search :: Search
search = Search
search' { sortBody = sorting }
Reply
resp' <- (Text -> Search -> m Reply) -> m Text -> m Search -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Search -> m Reply
forall (m :: * -> *). MonadBH m => Text -> Search -> m Reply
dispatchSearch m Text
url (Search -> m Search
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Search
search)
Reply -> m (Either EsError (SearchResult a))
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse Reply
resp'
getInitialSortedScroll ::
(FromJSON a, MonadThrow m, MonadBH m) => IndexName ->
MappingName ->
Search ->
m (Either EsError (SearchResult a))
getInitialSortedScroll :: forall a (m :: * -> *).
(FromJSON a, MonadThrow m, MonadBH m) =>
IndexName
-> MappingName -> Search -> m (Either EsError (SearchResult a))
getInitialSortedScroll (IndexName Text
indexName) (MappingName Text
mappingName) Search
search = do
let url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
mappingName, Text
"_search"]
params :: [(Text, Maybe Text)]
params = [(Text
"scroll", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"1m")]
Reply
resp' <- (Text -> Search -> m Reply) -> m Text -> m Search -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Search -> m Reply
forall (m :: * -> *). MonadBH m => Text -> Search -> m Reply
dispatchSearch m Text
url (Search -> m Search
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Search
search)
Reply -> m (Either EsError (SearchResult a))
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse Reply
resp'
scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId ->
m ([Hit a], Maybe ScrollId)
scroll' :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
scroll' Maybe ScrollId
Nothing = ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe ScrollId
forall a. Maybe a
Nothing)
scroll' (Just ScrollId
sid) = do
Either EsError (SearchResult a)
res <- ScrollId -> NominalDiffTime -> m (Either EsError (SearchResult a))
forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
ScrollId -> NominalDiffTime -> m (Either EsError (SearchResult a))
advanceScroll ScrollId
sid NominalDiffTime
60
case Either EsError (SearchResult a)
res of
Right SearchResult {Bool
Int
Maybe AggregationResults
Maybe NamedSuggestionResponse
Maybe ScrollId
ShardResult
SearchHits a
took :: Int
timedOut :: Bool
shards :: ShardResult
searchHits :: SearchHits a
aggregations :: Maybe AggregationResults
scrollId :: Maybe ScrollId
suggest :: Maybe NamedSuggestionResponse
took :: forall a. SearchResult a -> Int
timedOut :: forall a. SearchResult a -> Bool
shards :: forall a. SearchResult a -> ShardResult
searchHits :: forall a. SearchResult a -> SearchHits a
aggregations :: forall a. SearchResult a -> Maybe AggregationResults
scrollId :: forall a. SearchResult a -> Maybe ScrollId
suggest :: forall a. SearchResult a -> Maybe NamedSuggestionResponse
..} -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SearchHits a -> [Hit a]
forall a. SearchHits a -> [Hit a]
hits SearchHits a
searchHits, Maybe ScrollId
scrollId)
Left EsError
_ -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe ScrollId
forall a. Maybe a
Nothing)
advanceScroll
:: ( FromJSON a
, MonadBH m
, MonadThrow m
)
=> ScrollId
-> NominalDiffTime
-> m (Either EsError (SearchResult a))
advanceScroll :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
ScrollId -> NominalDiffTime -> m (Either EsError (SearchResult a))
advanceScroll (ScrollId Text
sid) NominalDiffTime
scroll = do
Text
url <- [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_search", Text
"scroll"]
Reply
resp <- Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post Text
url (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
scrollObject)
Reply -> m (Either EsError (SearchResult a))
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse Reply
resp
where scrollTime :: Text
scrollTime = Integer -> Text
forall a. Show a => a -> Text
showText Integer
secs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"s"
secs :: Integer
secs :: Integer
secs = NominalDiffTime -> Integer
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round NominalDiffTime
scroll
scrollObject :: Value
scrollObject = [Pair] -> Value
object [ Key
"scroll" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
scrollTime
, Key
"scroll_id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
sid
]
simpleAccumulator ::
(FromJSON a, MonadBH m, MonadThrow m) =>
[Hit a] ->
([Hit a], Maybe ScrollId) ->
m ([Hit a], Maybe ScrollId)
simpleAccumulator :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
[Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
simpleAccumulator [Hit a]
oldHits ([Hit a]
newHits, Maybe ScrollId
Nothing) = ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Hit a]
oldHits [Hit a] -> [Hit a] -> [Hit a]
forall a. [a] -> [a] -> [a]
++ [Hit a]
newHits, Maybe ScrollId
forall a. Maybe a
Nothing)
simpleAccumulator [Hit a]
oldHits ([], Maybe ScrollId
_) = ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Hit a]
oldHits, Maybe ScrollId
forall a. Maybe a
Nothing)
simpleAccumulator [Hit a]
oldHits ([Hit a]
newHits, Maybe ScrollId
msid) = do
([Hit a]
newHits', Maybe ScrollId
msid') <- Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
scroll' Maybe ScrollId
msid
[Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
[Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
simpleAccumulator ([Hit a]
oldHits [Hit a] -> [Hit a] -> [Hit a]
forall a. [a] -> [a] -> [a]
++ [Hit a]
newHits) ([Hit a]
newHits', Maybe ScrollId
msid')
scanSearch :: (FromJSON a, MonadBH m, MonadThrow m) => IndexName
-> MappingName
-> Search
-> m [Hit a]
scanSearch :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
IndexName -> MappingName -> Search -> m [Hit a]
scanSearch IndexName
indexName MappingName
mappingName Search
search = do
Either EsError (SearchResult a)
initialSearchResult <- IndexName
-> MappingName -> Search -> m (Either EsError (SearchResult a))
forall a (m :: * -> *).
(FromJSON a, MonadThrow m, MonadBH m) =>
IndexName
-> MappingName -> Search -> m (Either EsError (SearchResult a))
getInitialScroll IndexName
indexName MappingName
mappingName Search
search
let ([Hit a]
hits', Maybe ScrollId
josh) = case Either EsError (SearchResult a)
initialSearchResult of
Right SearchResult {Bool
Int
Maybe AggregationResults
Maybe NamedSuggestionResponse
Maybe ScrollId
ShardResult
SearchHits a
took :: forall a. SearchResult a -> Int
timedOut :: forall a. SearchResult a -> Bool
shards :: forall a. SearchResult a -> ShardResult
searchHits :: forall a. SearchResult a -> SearchHits a
aggregations :: forall a. SearchResult a -> Maybe AggregationResults
scrollId :: forall a. SearchResult a -> Maybe ScrollId
suggest :: forall a. SearchResult a -> Maybe NamedSuggestionResponse
took :: Int
timedOut :: Bool
shards :: ShardResult
searchHits :: SearchHits a
aggregations :: Maybe AggregationResults
scrollId :: Maybe ScrollId
suggest :: Maybe NamedSuggestionResponse
..} -> (SearchHits a -> [Hit a]
forall a. SearchHits a -> [Hit a]
hits SearchHits a
searchHits, Maybe ScrollId
scrollId)
Left EsError
_ -> ([], Maybe ScrollId
forall a. Maybe a
Nothing)
([Hit a]
totalHits, Maybe ScrollId
_) <- [Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
[Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
simpleAccumulator [] ([Hit a]
hits', Maybe ScrollId
josh)
[Hit a] -> m [Hit a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Hit a]
totalHits
mkSearch :: Maybe Query -> Maybe Filter -> Search
mkSearch :: Maybe Query -> Maybe Filter -> Search
mkSearch Maybe Query
query Maybe Filter
filter = Maybe Query
-> Maybe Filter
-> Maybe [SortSpec]
-> Maybe Aggregations
-> Maybe Highlights
-> Bool
-> From
-> Size
-> SearchType
-> Maybe [Value]
-> Maybe [FieldName]
-> Maybe ScriptFields
-> Maybe Source
-> Maybe Suggest
-> Search
Search Maybe Query
query Maybe Filter
filter Maybe [SortSpec]
forall a. Maybe a
Nothing Maybe Aggregations
forall a. Maybe a
Nothing Maybe Highlights
forall a. Maybe a
Nothing Bool
False (Int -> From
From Int
0) (Int -> Size
Size Int
10) SearchType
SearchTypeQueryThenFetch Maybe [Value]
forall a. Maybe a
Nothing Maybe [FieldName]
forall a. Maybe a
Nothing Maybe ScriptFields
forall a. Maybe a
Nothing Maybe Source
forall a. Maybe a
Nothing Maybe Suggest
forall a. Maybe a
Nothing
mkAggregateSearch :: Maybe Query -> Aggregations -> Search
mkAggregateSearch :: Maybe Query -> Aggregations -> Search
mkAggregateSearch Maybe Query
query Aggregations
mkSearchAggs = Maybe Query
-> Maybe Filter
-> Maybe [SortSpec]
-> Maybe Aggregations
-> Maybe Highlights
-> Bool
-> From
-> Size
-> SearchType
-> Maybe [Value]
-> Maybe [FieldName]
-> Maybe ScriptFields
-> Maybe Source
-> Maybe Suggest
-> Search
Search Maybe Query
query Maybe Filter
forall a. Maybe a
Nothing Maybe [SortSpec]
forall a. Maybe a
Nothing (Aggregations -> Maybe Aggregations
forall a. a -> Maybe a
Just Aggregations
mkSearchAggs) Maybe Highlights
forall a. Maybe a
Nothing Bool
False (Int -> From
From Int
0) (Int -> Size
Size Int
0) SearchType
SearchTypeQueryThenFetch Maybe [Value]
forall a. Maybe a
Nothing Maybe [FieldName]
forall a. Maybe a
Nothing Maybe ScriptFields
forall a. Maybe a
Nothing Maybe Source
forall a. Maybe a
Nothing Maybe Suggest
forall a. Maybe a
Nothing
mkHighlightSearch :: Maybe Query -> Highlights -> Search
mkHighlightSearch :: Maybe Query -> Highlights -> Search
mkHighlightSearch Maybe Query
query Highlights
searchHighlights = Maybe Query
-> Maybe Filter
-> Maybe [SortSpec]
-> Maybe Aggregations
-> Maybe Highlights
-> Bool
-> From
-> Size
-> SearchType
-> Maybe [Value]
-> Maybe [FieldName]
-> Maybe ScriptFields
-> Maybe Source
-> Maybe Suggest
-> Search
Search Maybe Query
query Maybe Filter
forall a. Maybe a
Nothing Maybe [SortSpec]
forall a. Maybe a
Nothing Maybe Aggregations
forall a. Maybe a
Nothing (Highlights -> Maybe Highlights
forall a. a -> Maybe a
Just Highlights
searchHighlights) Bool
False (Int -> From
From Int
0) (Int -> Size
Size Int
10) SearchType
SearchTypeQueryThenFetch Maybe [Value]
forall a. Maybe a
Nothing Maybe [FieldName]
forall a. Maybe a
Nothing Maybe ScriptFields
forall a. Maybe a
Nothing Maybe Source
forall a. Maybe a
Nothing Maybe Suggest
forall a. Maybe a
Nothing
pageSearch :: From
-> Size
-> Search
-> Search
pageSearch :: From -> Size -> Search -> Search
pageSearch From
resultOffset Size
pageSize Search
search = Search
search { from = resultOffset, size = pageSize }
parseUrl' :: MonadThrow m => Text -> m Request
parseUrl' :: forall (m :: * -> *). MonadThrow m => Text -> m Request
parseUrl' Text
t = [Char] -> m Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest ((Char -> Bool) -> [Char] -> [Char]
URI.escapeURIString Char -> Bool
URI.isAllowedInURI (Text -> [Char]
T.unpack Text
t))
isVersionConflict :: Reply -> Bool
isVersionConflict :: Reply -> Bool
isVersionConflict = (Int -> Bool) -> Reply -> Bool
statusCheck (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
409)
isSuccess :: Reply -> Bool
isSuccess :: Reply -> Bool
isSuccess = (Int -> Bool) -> Reply -> Bool
statusCheck ((Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
200, Int
299))
isCreated :: Reply -> Bool
isCreated :: Reply -> Bool
isCreated = (Int -> Bool) -> Reply -> Bool
statusCheck (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
201)
statusCheck :: (Int -> Bool) -> Reply -> Bool
statusCheck :: (Int -> Bool) -> Reply -> Bool
statusCheck Int -> Bool
prd = Int -> Bool
prd (Int -> Bool) -> (Reply -> Int) -> Reply -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Int
NHTS.statusCode (Status -> Int) -> (Reply -> Status) -> Reply -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply -> Status
forall body. Response body -> Status
responseStatus
basicAuthHook :: Monad m => EsUsername -> EsPassword -> Request -> m Request
basicAuthHook :: forall (m :: * -> *).
Monad m =>
EsUsername -> EsPassword -> Request -> m Request
basicAuthHook (EsUsername Text
u) (EsPassword Text
p) = Request -> m Request
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> m Request)
-> (Request -> Request) -> Request -> m Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
applyBasicAuth ByteString
u' ByteString
p'
where u' :: ByteString
u' = Text -> ByteString
T.encodeUtf8 Text
u
p' :: ByteString
p' = Text -> ByteString
T.encodeUtf8 Text
p
boolQP :: Bool -> Text
boolQP :: Bool -> Text
boolQP Bool
True = Text
"true"
boolQP Bool
False = Text
"false"
countByIndex :: (MonadBH m, MonadThrow m) => IndexName -> CountQuery -> m (Either EsError CountResponse)
countByIndex :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
IndexName -> CountQuery -> m (Either EsError CountResponse)
countByIndex (IndexName Text
indexName) CountQuery
q = do
Text
url <- [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_count"]
Reply -> m (Either EsError CountResponse)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError CountResponse))
-> m Reply -> m (Either EsError CountResponse)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post Text
url (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (CountQuery -> ByteString
forall a. ToJSON a => a -> ByteString
encode CountQuery
q))
reindex :: (MonadBH m, MonadThrow m) => ReindexRequest -> m (Either EsError ReindexResponse)
reindex :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
ReindexRequest -> m (Either EsError ReindexResponse)
reindex ReindexRequest
req = do
Text
url <- [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_reindex"]
Reply -> m (Either EsError ReindexResponse)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError ReindexResponse))
-> m Reply -> m (Either EsError ReindexResponse)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post Text
url (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ReindexRequest -> ByteString
forall a. ToJSON a => a -> ByteString
encode ReindexRequest
req))
reindexAsync :: (MonadBH m, MonadThrow m) => ReindexRequest -> m (Either EsError TaskNodeId)
reindexAsync :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
ReindexRequest -> m (Either EsError TaskNodeId)
reindexAsync ReindexRequest
req = do
Text
url <- [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text
"wait_for_completion", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"false")] (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_reindex"]
Reply -> m (Either EsError TaskNodeId)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError TaskNodeId))
-> m Reply -> m (Either EsError TaskNodeId)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post Text
url (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ReindexRequest -> ByteString
forall a. ToJSON a => a -> ByteString
encode ReindexRequest
req))
getTask :: (MonadBH m, MonadThrow m, FromJSON a) => TaskNodeId -> m (Either EsError (TaskResponse a))
getTask :: forall (m :: * -> *) a.
(MonadBH m, MonadThrow m, FromJSON a) =>
TaskNodeId -> m (Either EsError (TaskResponse a))
getTask (TaskNodeId Text
task) = do
Text
url <- [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_tasks", Text
task]
Reply -> m (Either EsError (TaskResponse a))
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError (TaskResponse a)))
-> m Reply -> m (Either EsError (TaskResponse a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get Text
url