{-# 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
, getDocument
, documentExists
, deleteDocument
, deleteByQuery
, searchAll
, searchByIndex
, searchByIndices
, searchByIndexTemplate
, searchByIndicesTemplate
, scanSearch
, getInitialScroll
, getInitialSortedScroll
, advanceScroll
, refreshIndex
, mkSearch
, mkAggregateSearch
, mkHighlightSearch
, mkSearchTemplate
, bulk
, pageSearch
, mkShardCount
, mkReplicaCount
, getStatus
, storeSearchTemplate
, getSearchTemplate
, deleteSearchTemplate
, getSnapshotRepos
, updateSnapshotRepo
, verifySnapshotRepo
, deleteSnapshotRepo
, createSnapshot
, getSnapshots
, deleteSnapshot
, restoreSnapshot
, getNodesInfo
, getNodesStats
, encodeBulkOperations
, encodeBulkOperation
, basicAuthHook
, isVersionConflict
, isSuccess
, isCreated
, parseEsResponse
, countByIndex
)
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 Data.ByteString.Lazy.Builder
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Foldable (toList)
import qualified Data.HashMap.Strict as HM
import Data.Ix
import qualified Data.List as LS (foldl')
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (catMaybes, fromMaybe)
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 :: Method -> Text -> Maybe ByteString -> m Reply
dispatch Method
dMethod Text
url Maybe ByteString
body = do
Request
initReq <- IO Request -> m Request
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 (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 :: Method
method = Method
dMethod
, requestHeaders :: RequestHeaders
requestHeaders =
(HeaderName
"Content-Type", Method
"application/json") (HeaderName, Method) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: Request -> RequestHeaders
requestHeaders Request
initReq
, requestBody :: RequestBody
requestBody = 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 (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 :: [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 (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 =
Method -> Text
T.decodeUtf8 (Method -> Text) -> Method -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Method
BB.toByteString (Builder -> Method) -> Builder -> Method
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 :: (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m b
mb)
withBH :: ManagerSettings -> Server -> BH IO a -> IO a
withBH :: 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 :: 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 (Method -> Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Method -> Text -> Maybe ByteString -> m Reply
dispatch Method
NHTM.methodDelete) Maybe ByteString
forall a. Maybe a
Nothing
get :: MonadBH m => Text -> m Reply
get :: 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 (Method -> Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Method -> Text -> Maybe ByteString -> m Reply
dispatch Method
NHTM.methodGet) Maybe ByteString
forall a. Maybe a
Nothing
head :: MonadBH m => Text -> m Reply
head :: 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 (Method -> Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Method -> Text -> Maybe ByteString -> m Reply
dispatch Method
NHTM.methodHead) Maybe ByteString
forall a. Maybe a
Nothing
put :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
put :: Text -> Maybe ByteString -> m Reply
put = Method -> Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Method -> Text -> Maybe ByteString -> m Reply
dispatch Method
NHTM.methodPut
post :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
post :: Text -> Maybe ByteString -> m Reply
post = Method -> Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Method -> Text -> Maybe ByteString -> m Reply
dispatch Method
NHTM.methodPost
getStatus :: MonadBH m => m (Maybe Status)
getStatus :: 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 (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 :: SnapshotRepoSelection -> m (Either EsError [GenericSnapshotRepo])
getSnapshotRepos SnapshotRepoSelection
sel = (Either EsError GSRs -> Either EsError [GenericSnapshotRepo])
-> m (Either EsError GSRs)
-> m (Either EsError [GenericSnapshotRepo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GSRs -> [GenericSnapshotRepo])
-> Either EsError GSRs -> Either EsError [GenericSnapshotRepo]
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 (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
. ((Text, Value) -> Parser GenericSnapshotRepo)
-> [(Text, Value)] -> Parser [GenericSnapshotRepo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Text -> Value -> Parser GenericSnapshotRepo)
-> (Text, Value) -> Parser GenericSnapshotRepo
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Value -> Parser GenericSnapshotRepo
go) ([(Text, Value)] -> Parser [GenericSnapshotRepo])
-> (Object -> [(Text, Value)])
-> Object
-> Parser [GenericSnapshotRepo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList
go :: Text -> Value -> Parser GenericSnapshotRepo
go Text
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 Text
rawName) (SnapshotRepoType
-> GenericSnapshotRepoSettings -> GenericSnapshotRepo)
-> Parser SnapshotRepoType
-> Parser (GenericSnapshotRepoSettings -> GenericSnapshotRepo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser SnapshotRepoType
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"
Parser (GenericSnapshotRepoSettings -> GenericSnapshotRepo)
-> Parser GenericSnapshotRepoSettings -> Parser GenericSnapshotRepo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser GenericSnapshotRepoSettings
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"settings"
updateSnapshotRepo
:: ( MonadBH m
, SnapshotRepo repo
)
=> SnapshotRepoUpdateSettings
-> repo
-> m Reply
updateSnapshotRepo :: SnapshotRepoUpdateSettings -> repo -> m Reply
updateSnapshotRepo SnapshotRepoUpdateSettings {Bool
repoUpdateVerify :: SnapshotRepoUpdateSettings -> Bool
repoUpdateVerify :: 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 (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
$ [(Text, Value)] -> Value
object [ Text
"type" Text -> SnapshotRepoType -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SnapshotRepoType
gSnapshotRepoType
, Text
"settings" Text -> GenericSnapshotRepoSettings -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= GenericSnapshotRepoSettings
gSnapshotRepoSettings
]
GenericSnapshotRepo {GenericSnapshotRepoSettings
SnapshotRepoType
SnapshotRepoName
gSnapshotRepoSettings :: GenericSnapshotRepo -> GenericSnapshotRepoSettings
gSnapshotRepoType :: GenericSnapshotRepo -> SnapshotRepoType
gSnapshotRepoName :: GenericSnapshotRepo -> SnapshotRepoName
gSnapshotRepoSettings :: GenericSnapshotRepoSettings
gSnapshotRepoType :: SnapshotRepoType
gSnapshotRepoName :: SnapshotRepoName
..} = repo -> GenericSnapshotRepo
forall r. SnapshotRepo r => r -> GenericSnapshotRepo
toGSnapshotRepo repo
repo
verifySnapshotRepo
:: ( MonadBH m
, MonadThrow m
)
=> SnapshotRepoName
-> m (Either EsError SnapshotVerification)
verifySnapshotRepo :: 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 (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 :: 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 :: SnapshotRepoName
-> SnapshotName -> SnapshotCreateSettings -> m Reply
createSnapshot (SnapshotRepoName Text
repoName)
(SnapshotName Text
snapName)
SnapshotCreateSettings {Bool
Maybe IndexSelection
snapPartial :: SnapshotCreateSettings -> Bool
snapIncludeGlobalState :: SnapshotCreateSettings -> Bool
snapIgnoreUnavailable :: SnapshotCreateSettings -> Bool
snapIndices :: SnapshotCreateSettings -> Maybe IndexSelection
snapWaitForCompletion :: SnapshotCreateSettings -> Bool
snapPartial :: Bool
snapIncludeGlobalState :: Bool
snapIgnoreUnavailable :: Bool
snapIndices :: Maybe IndexSelection
snapWaitForCompletion :: 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 (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
$ [(Text, Value)] -> Value
object [(Text, Value)]
prs
prs :: [(Text, Value)]
prs = [Maybe (Text, Value)] -> [(Text, Value)]
forall a. [Maybe a] -> [a]
catMaybes [ (Text
"indices" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (Text -> (Text, Value))
-> (IndexSelection -> Text) -> IndexSelection -> (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexSelection -> Text
indexSelectionName (IndexSelection -> (Text, Value))
-> Maybe IndexSelection -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe IndexSelection
snapIndices
, (Text, Value) -> Maybe (Text, Value)
forall a. a -> Maybe a
Just (Text
"ignore_unavailable" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
snapIgnoreUnavailable)
, (Text, Value) -> Maybe (Text, Value)
forall a. a -> Maybe a
Just (Text
"ignore_global_state" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
snapIncludeGlobalState)
, (Text, Value) -> Maybe (Text, Value)
forall a. a -> Maybe a
Just (Text
"partial" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= 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 :: 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SIs -> [SnapshotInfo])
-> Either EsError SIs -> Either EsError [SnapshotInfo]
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 -> Text -> Parser [SnapshotInfo]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"snapshots"
deleteSnapshot :: MonadBH m => SnapshotRepoName -> SnapshotName -> m Reply
deleteSnapshot :: 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 :: 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
snapRestoreIgnoreIndexSettings :: SnapshotRestoreSettings -> Maybe (NonEmpty Text)
snapRestoreIndexSettingsOverrides :: SnapshotRestoreSettings -> Maybe RestoreIndexSettings
snapRestoreIncludeAliases :: SnapshotRestoreSettings -> Bool
snapRestorePartial :: SnapshotRestoreSettings -> Bool
snapRestoreRenameReplacement :: SnapshotRestoreSettings -> Maybe (NonEmpty RestoreRenameToken)
snapRestoreRenamePattern :: SnapshotRestoreSettings -> Maybe RestoreRenamePattern
snapRestoreIncludeGlobalState :: SnapshotRestoreSettings -> Bool
snapRestoreIgnoreUnavailable :: SnapshotRestoreSettings -> Bool
snapRestoreIndices :: SnapshotRestoreSettings -> Maybe IndexSelection
snapRestoreWaitForCompletion :: SnapshotRestoreSettings -> Bool
snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
snapRestoreIncludeAliases :: Bool
snapRestorePartial :: Bool
snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
snapRestoreRenamePattern :: Maybe RestoreRenamePattern
snapRestoreIncludeGlobalState :: Bool
snapRestoreIgnoreUnavailable :: Bool
snapRestoreIndices :: Maybe IndexSelection
snapRestoreWaitForCompletion :: 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 (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 ([(Text, Value)] -> Value
object [(Text, Value)]
prs)
prs :: [(Text, Value)]
prs = [Maybe (Text, Value)] -> [(Text, Value)]
forall a. [Maybe a] -> [a]
catMaybes [ (Text
"indices" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (Text -> (Text, Value))
-> (IndexSelection -> Text) -> IndexSelection -> (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexSelection -> Text
indexSelectionName (IndexSelection -> (Text, Value))
-> Maybe IndexSelection -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe IndexSelection
snapRestoreIndices
, (Text, Value) -> Maybe (Text, Value)
forall a. a -> Maybe a
Just (Text
"ignore_unavailable" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
snapRestoreIgnoreUnavailable)
, (Text, Value) -> Maybe (Text, Value)
forall a. a -> Maybe a
Just (Text
"include_global_state" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
snapRestoreIncludeGlobalState)
, (Text
"rename_pattern" Text -> RestoreRenamePattern -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (RestoreRenamePattern -> (Text, Value))
-> Maybe RestoreRenamePattern -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RestoreRenamePattern
snapRestoreRenamePattern
, (Text
"rename_replacement" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (Text -> (Text, Value))
-> (NonEmpty RestoreRenameToken -> Text)
-> NonEmpty RestoreRenameToken
-> (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty RestoreRenameToken -> Text
renderTokens (NonEmpty RestoreRenameToken -> (Text, Value))
-> Maybe (NonEmpty RestoreRenameToken) -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty RestoreRenameToken)
snapRestoreRenameReplacement
, (Text, Value) -> Maybe (Text, Value)
forall a. a -> Maybe a
Just (Text
"include_aliases" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
snapRestoreIncludeAliases)
, (Text
"index_settings" Text -> RestoreIndexSettings -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ) (RestoreIndexSettings -> (Text, Value))
-> Maybe RestoreIndexSettings -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RestoreIndexSettings
snapRestoreIndexSettingsOverrides
, (Text
"ignore_index_settings" Text -> NonEmpty Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ) (NonEmpty Text -> (Text, Value))
-> Maybe (NonEmpty Text) -> Maybe (Text, Value)
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 :: 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 :: 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 :: 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 (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 :: [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 (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
$ [(Text, Value)] -> Value
object
[Text
"settings" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Object] -> Object
deepMerge
( Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Text
"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 :: 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 :: 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 :: 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 (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 (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty UpdatableIndexSetting
updates])
getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
-> m (Either EsError IndexSettingsSummary)
getIndexSettings :: 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 :: IndexSelection -> ForceMergeIndexSettings -> m Reply
forceMergeIndex IndexSelection
ixs ForceMergeIndexSettings {Bool
Maybe Int
flushAfterOptimize :: ForceMergeIndexSettings -> Bool
onlyExpungeDeletes :: ForceMergeIndexSettings -> Bool
maxNumSegments :: ForceMergeIndexSettings -> Maybe Int
flushAfterOptimize :: Bool
onlyExpungeDeletes :: Bool
maxNumSegments :: Maybe Int
..} =
(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 (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 (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
LS.foldl' Object -> Object -> Object
forall k.
(Eq k, Hashable k) =>
HashMap k Value -> HashMap k Value -> HashMap k Value
go Object
forall a. Monoid a => a
mempty
where go :: HashMap k Value -> HashMap k Value -> HashMap k Value
go HashMap k Value
acc = (HashMap k Value -> (k, Value) -> HashMap k Value)
-> HashMap k Value -> [(k, Value)] -> HashMap k Value
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
LS.foldl' HashMap k Value -> (k, Value) -> HashMap k Value
forall k.
(Eq k, Hashable k) =>
HashMap k Value -> (k, Value) -> HashMap k Value
go' HashMap k Value
acc ([(k, Value)] -> HashMap k Value)
-> (HashMap k Value -> [(k, Value)])
-> HashMap k Value
-> HashMap k Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k Value -> [(k, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList
go' :: HashMap k Value -> (k, Value) -> HashMap k Value
go' HashMap k Value
acc (k
k, Value
v) = (Value -> Value -> Value)
-> k -> Value -> HashMap k Value -> HashMap k Value
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith Value -> Value -> Value
merge k
k Value
v HashMap k Value
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
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 :: 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 (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 :: 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 (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 (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 (m :: * -> *) e a. (MonadThrow m, 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 :: 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 (m :: * -> *) a. Monad m => a -> m a
return Bool
exists
refreshIndex :: MonadBH m => IndexName -> m Reply
refreshIndex :: 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 (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 :: 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 :: 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 (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 :: 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 :: 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 :: 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 (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> ByteString -> EsProtocolException
EsProtocolException ([Char] -> Text
T.pack [Char]
msg) ByteString
body))) t IndexName -> m (t IndexName)
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 Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
"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 :: 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 (m :: * -> *) e a. (MonadThrow m, 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 (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 (Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
"index" Object
obj, Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
"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 :: 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 (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 = [(Text, Value)] -> Value
object [ Text
"actions" Text -> [IndexAliasAction] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= NonEmpty IndexAliasAction -> [IndexAliasAction]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexAliasAction
actions]
getIndexAliases :: (MonadBH m, MonadThrow m)
=> m (Either EsError IndexAliasesSummary)
getIndexAliases :: 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 :: 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 :: 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 (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 :: 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 (m :: * -> *) a. Monad m => a -> m a
return Bool
exists
deleteTemplate :: MonadBH m => TemplateName -> m Reply
deleteTemplate :: 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 -> a -> m Reply
putMapping :: IndexName -> a -> m Reply
putMapping (IndexName Text
indexName) 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 (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"]
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
-> IndexDocumentSettings -> doc -> DocId -> m Reply
indexDocument :: IndexName -> IndexDocumentSettings -> doc -> DocId -> m Reply
indexDocument (IndexName Text
indexName) 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 (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
where url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery (IndexDocumentSettings -> DocId -> [(Text, Maybe Text)]
indexQueryString IndexDocumentSettings
cfg (Text -> DocId
DocId Text
docId)) (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
"_doc", Text
docId]
jsonBody :: Value
jsonBody = IndexDocumentSettings -> doc -> Value
forall doc. ToJSON doc => IndexDocumentSettings -> doc -> Value
encodeDocument IndexDocumentSettings
cfg doc
document
body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
jsonBody)
updateDocument :: (ToJSON patch, MonadBH m) => IndexName
-> IndexDocumentSettings -> patch -> DocId -> m Reply
updateDocument :: IndexName -> IndexDocumentSettings -> patch -> DocId -> m Reply
updateDocument (IndexName Text
indexName) 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 (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
where url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery (IndexDocumentSettings -> DocId -> [(Text, Maybe Text)]
indexQueryString IndexDocumentSettings
cfg (Text -> DocId
DocId Text
docId)) (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
"_update", Text
docId]
jsonBody :: Value
jsonBody = IndexDocumentSettings -> patch -> Value
forall doc. ToJSON doc => IndexDocumentSettings -> doc -> Value
encodeDocument IndexDocumentSettings
cfg patch
patch
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
$ [(Text, Value)] -> Value
object [Text
"doc" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
jsonBody])
indexQueryString :: IndexDocumentSettings -> DocId -> [(Text, Maybe Text)]
indexQueryString :: IndexDocumentSettings -> DocId -> [(Text, Maybe Text)]
indexQueryString IndexDocumentSettings
cfg (DocId Text
docId) =
IndexDocumentSettings -> [(Text, Maybe Text)]
versionCtlParams IndexDocumentSettings
cfg [(Text, Maybe Text)]
-> [(Text, Maybe Text)] -> [(Text, Maybe Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Maybe Text)]
routeParams
where
routeParams :: [(Text, Maybe Text)]
routeParams = case IndexDocumentSettings -> Maybe JoinRelation
idsJoinRelation IndexDocumentSettings
cfg of
Maybe JoinRelation
Nothing -> []
Just (ParentDocument FieldName
_ RelationName
_) -> [(Text
"routing", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
docId)]
Just (ChildDocument FieldName
_ RelationName
_ (DocId Text
pid)) -> [(Text
"routing", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pid)]
encodeDocument :: ToJSON doc => IndexDocumentSettings -> doc -> Value
encodeDocument :: IndexDocumentSettings -> doc -> Value
encodeDocument IndexDocumentSettings
cfg doc
document =
case IndexDocumentSettings -> Maybe JoinRelation
idsJoinRelation IndexDocumentSettings
cfg of
Maybe JoinRelation
Nothing -> doc -> Value
forall a. ToJSON a => a -> Value
toJSON doc
document
Just (ParentDocument (FieldName Text
field) RelationName
name) ->
Value -> Value -> Value
mergeObjects (doc -> Value
forall a. ToJSON a => a -> Value
toJSON doc
document) ([(Text, Value)] -> Value
object [Text
field Text -> RelationName -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= RelationName
name])
Just (ChildDocument (FieldName Text
field) RelationName
name DocId
parent) ->
Value -> Value -> Value
mergeObjects (doc -> Value
forall a. ToJSON a => a -> Value
toJSON doc
document) ([(Text, Value)] -> Value
object [Text
field Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [(Text, Value)] -> Value
object [Text
"name" Text -> RelationName -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= RelationName
name, Text
"parent" Text -> DocId -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DocId
parent]])
where
mergeObjects :: Value -> Value -> Value
mergeObjects (Object Object
a) (Object Object
b) = Object -> Value
Object (Object
a Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
b)
mergeObjects Value
_ Value
_ = [Char] -> Value
forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible happened: both document body and join parameters must be objects"
deleteDocument :: MonadBH m => IndexName -> DocId -> m Reply
deleteDocument :: IndexName -> DocId -> m Reply
deleteDocument (IndexName Text
indexName) (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
"_doc", Text
docId]
deleteByQuery :: MonadBH m => IndexName -> Query -> m Reply
deleteByQuery :: IndexName -> Query -> m Reply
deleteByQuery (IndexName Text
indexName) 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 (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
"_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
$ [(Text, Value)] -> Value
object [ Text
"query" Text -> Query -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Query
query ])
bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
bulk :: 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 (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 (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 (Method -> Builder
byteString Method
"\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
<> Method -> Builder
byteString Method
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
lazyByteString ByteString
x)
mkBulkStreamValue :: Text -> Text -> Text -> Value
mkBulkStreamValue :: Text -> Text -> Text -> Value
mkBulkStreamValue Text
operation Text
indexName Text
docId =
[(Text, Value)] -> Value
object [Text
operation Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
[(Text, Value)] -> Value
object [ Text
"_index" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
indexName
, Text
"_id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
docId]]
mkBulkStreamValueAuto :: Text -> Text -> Value
mkBulkStreamValueAuto :: Text -> Text -> Value
mkBulkStreamValueAuto Text
operation Text
indexName =
[(Text, Value)] -> Value
object [Text
operation Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
[(Text, Value)] -> Value
object [ Text
"_index" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
indexName ]]
mkBulkStreamValueWithMeta :: [UpsertActionMetadata] -> Text -> Text -> Text -> Value
mkBulkStreamValueWithMeta :: [UpsertActionMetadata] -> Text -> Text -> Text -> Value
mkBulkStreamValueWithMeta [UpsertActionMetadata]
meta Text
operation Text
indexName Text
docId =
[(Text, Value)] -> Value
object [ Text
operation Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
[(Text, Value)] -> Value
object ([ Text
"_index" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
indexName
, Text
"_id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
docId]
[(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> (UpsertActionMetadata -> (Text, Value)
buildUpsertActionMetadata (UpsertActionMetadata -> (Text, Value))
-> [UpsertActionMetadata] -> [(Text, Value)]
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) (DocId Text
docId) Value
value) = ByteString
blob
where metadata :: Value
metadata = Text -> Text -> Text -> Value
mkBulkStreamValue Text
"index" Text
indexName 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) Value
value) = ByteString
blob
where metadata :: Value
metadata = Text -> Text -> Value
mkBulkStreamValueAuto Text
"index" Text
indexName
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) Encoding
encoding) = Builder -> ByteString
toLazyByteString Builder
blob
where metadata :: Encoding
metadata = Value -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Text -> Value
mkBulkStreamValueAuto Text
"index" Text
indexName)
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) (DocId Text
docId) Value
value) = ByteString
blob
where metadata :: Value
metadata = Text -> Text -> Text -> Value
mkBulkStreamValue Text
"create" Text
indexName 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) (DocId Text
docId)) = ByteString
blob
where metadata :: Value
metadata = Text -> Text -> Text -> Value
mkBulkStreamValue Text
"delete" Text
indexName Text
docId
blob :: ByteString
blob = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
metadata
encodeBulkOperation (BulkUpdate (IndexName Text
indexName) (DocId Text
docId) Value
value) = ByteString
blob
where metadata :: Value
metadata = Text -> Text -> Text -> Value
mkBulkStreamValue Text
"update" Text
indexName Text
docId
doc :: Value
doc = [(Text, Value)] -> Value
object [Text
"doc" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= 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)
(DocId Text
docId)
UpsertPayload
payload
[UpsertActionMetadata]
actionMeta) = ByteString
blob
where metadata :: Value
metadata = [UpsertActionMetadata] -> Text -> Text -> Text -> Value
mkBulkStreamValueWithMeta [UpsertActionMetadata]
actionMeta Text
"update" Text
indexName 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 -> [(Text, Value)] -> Value
object [Text
"doc" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
value, Text
"doc_as_upsert" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
True]
UpsertScript Bool
scriptedUpsert Script
script Value
value ->
let scup :: [(Text, Value)]
scup = if Bool
scriptedUpsert then [Text
"scripted_upsert" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
True] else []
upsert :: [(Text, Value)]
upsert = [Text
"upsert" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
value]
in
case ([(Text, Value)] -> Value
object ([(Text, Value)]
scup [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Value)]
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) (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 -> Value
mkBulkStreamValue Text
"create" Text
indexName 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 -> DocId -> m Reply
getDocument :: IndexName -> DocId -> m Reply
getDocument (IndexName Text
indexName) (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
"_doc", Text
docId]
documentExists :: MonadBH m => IndexName -> DocId -> m Bool
documentExists :: IndexName -> DocId -> m Bool
documentExists (IndexName Text
indexName) (DocId Text
docId) =
((Reply, Bool) -> Bool) -> m (Reply, Bool) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Reply, Bool) -> Bool
forall a b. (a, b) -> b
snd (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, Text
"_doc", Text
docId])
dispatchSearch :: MonadBH m => Text -> Search -> m Reply
dispatchSearch :: 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 :: 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 (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 :: 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 (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 :: 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 (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 (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexName
ixs))
dispatchSearchTemplate :: MonadBH m => Text -> SearchTemplate -> m Reply
dispatchSearchTemplate :: Text -> SearchTemplate -> m Reply
dispatchSearchTemplate Text
url SearchTemplate
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 (SearchTemplate -> ByteString
forall a. ToJSON a => a -> ByteString
encode SearchTemplate
search))
searchByIndexTemplate :: MonadBH m => IndexName -> SearchTemplate -> m Reply
searchByIndexTemplate :: IndexName -> SearchTemplate -> m Reply
searchByIndexTemplate (IndexName Text
indexName) = (Text -> SearchTemplate -> m Reply)
-> m Text -> m SearchTemplate -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> SearchTemplate -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> SearchTemplate -> m Reply
dispatchSearchTemplate m Text
url (m SearchTemplate -> m Reply)
-> (SearchTemplate -> m SearchTemplate)
-> SearchTemplate
-> m Reply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchTemplate -> m SearchTemplate
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", Text
"template"]
searchByIndicesTemplate :: MonadBH m => NonEmpty IndexName -> SearchTemplate -> m Reply
searchByIndicesTemplate :: NonEmpty IndexName -> SearchTemplate -> m Reply
searchByIndicesTemplate NonEmpty IndexName
ixs = (Text -> SearchTemplate -> m Reply)
-> m Text -> m SearchTemplate -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> SearchTemplate -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> SearchTemplate -> m Reply
dispatchSearchTemplate m Text
url (m SearchTemplate -> m Reply)
-> (SearchTemplate -> m SearchTemplate)
-> SearchTemplate
-> m Reply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchTemplate -> m SearchTemplate
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", Text
"template"]
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 (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexName
ixs))
storeSearchTemplate :: MonadBH m => SearchTemplateId -> SearchTemplateSource -> m Reply
storeSearchTemplate :: SearchTemplateId -> SearchTemplateSource -> m Reply
storeSearchTemplate (SearchTemplateId Text
tid) SearchTemplateSource
ts =
m Text
url m Text -> (Text -> m Reply) -> m Reply
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Maybe ByteString -> m Reply)
-> Maybe ByteString -> Text -> m Reply
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
json))
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_scripts", Text
tid]
json :: Value
json = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Text, Value)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [Text
"script" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Object -> Value
Object (Text
"lang" Text -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"mustache" Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Text
"source" Text -> SearchTemplateSource -> Object
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SearchTemplateSource
ts) ]
getSearchTemplate :: MonadBH m => SearchTemplateId -> m Reply
getSearchTemplate :: SearchTemplateId -> m Reply
getSearchTemplate (SearchTemplateId Text
tid) =
m Text
url m Text -> (Text -> m Reply) -> m Reply
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_scripts", Text
tid]
deleteSearchTemplate :: MonadBH m => SearchTemplateId -> m Reply
deleteSearchTemplate :: SearchTemplateId -> m Reply
deleteSearchTemplate (SearchTemplateId Text
tid) =
m Text
url m Text -> (Text -> m Reply) -> m Reply
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
delete
where
url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_scripts", Text
tid]
getInitialScroll ::
(FromJSON a, MonadThrow m, MonadBH m) => IndexName ->
Search ->
m (Either EsError (SearchResult a))
getInitialScroll :: IndexName -> Search -> m (Either EsError (SearchResult a))
getInitialScroll (IndexName Text
indexName) 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
"_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 :: Maybe [SortSpec]
sortBody = Maybe [SortSpec]
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 (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 ->
Search ->
m (Either EsError (SearchResult a))
getInitialSortedScroll :: IndexName -> Search -> m (Either EsError (SearchResult a))
getInitialSortedScroll (IndexName Text
indexName) 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
"_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 (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' :: Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
scroll' Maybe ScrollId
Nothing = ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
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
suggest :: forall a. SearchResult a -> Maybe NamedSuggestionResponse
scrollId :: forall a. SearchResult a -> Maybe ScrollId
aggregations :: forall a. SearchResult a -> Maybe AggregationResults
searchHits :: forall a. SearchResult a -> SearchHits a
shards :: forall a. SearchResult a -> ShardResult
timedOut :: forall a. SearchResult a -> Bool
took :: forall a. SearchResult a -> Int
suggest :: Maybe NamedSuggestionResponse
scrollId :: Maybe ScrollId
aggregations :: Maybe AggregationResults
searchHits :: SearchHits a
shards :: ShardResult
timedOut :: Bool
took :: Int
..} -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
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 (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 :: 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 a b. (RealFrac a, Integral b) => a -> b
round NominalDiffTime
scroll
scrollObject :: Value
scrollObject = [(Text, Value)] -> Value
object [ Text
"scroll" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
scrollTime
, Text
"scroll_id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
sid
]
simpleAccumulator ::
(FromJSON a, MonadBH m, MonadThrow m) =>
[Hit a] ->
([Hit a], Maybe ScrollId) ->
m ([Hit a], Maybe ScrollId)
simpleAccumulator :: [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 (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 (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
-> Search
-> m [Hit a]
scanSearch :: IndexName -> Search -> m [Hit a]
scanSearch IndexName
indexName Search
search = do
Either EsError (SearchResult a)
initialSearchResult <- IndexName -> Search -> m (Either EsError (SearchResult a))
forall a (m :: * -> *).
(FromJSON a, MonadThrow m, MonadBH m) =>
IndexName -> Search -> m (Either EsError (SearchResult a))
getInitialScroll IndexName
indexName 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
suggest :: Maybe NamedSuggestionResponse
scrollId :: Maybe ScrollId
aggregations :: Maybe AggregationResults
searchHits :: SearchHits a
shards :: ShardResult
timedOut :: Bool
took :: Int
suggest :: forall a. SearchResult a -> Maybe NamedSuggestionResponse
scrollId :: forall a. SearchResult a -> Maybe ScrollId
aggregations :: forall a. SearchResult a -> Maybe AggregationResults
searchHits :: forall a. SearchResult a -> SearchHits a
shards :: forall a. SearchResult a -> ShardResult
timedOut :: forall a. SearchResult a -> Bool
took :: forall a. SearchResult a -> Int
..} -> (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 (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
mkSearchTemplate :: Either SearchTemplateId SearchTemplateSource -> TemplateQueryKeyValuePairs -> SearchTemplate
mkSearchTemplate :: Either SearchTemplateId SearchTemplateSource
-> TemplateQueryKeyValuePairs -> SearchTemplate
mkSearchTemplate Either SearchTemplateId SearchTemplateSource
id TemplateQueryKeyValuePairs
params = Either SearchTemplateId SearchTemplateSource
-> TemplateQueryKeyValuePairs
-> Maybe Bool
-> Maybe Bool
-> SearchTemplate
SearchTemplate Either SearchTemplateId SearchTemplateSource
id TemplateQueryKeyValuePairs
params Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
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 :: From
from = From
resultOffset, size :: Size
size = Size
pageSize }
parseUrl' :: MonadThrow m => Text -> m Request
parseUrl' :: 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 :: EsUsername -> EsPassword -> Request -> m Request
basicAuthHook (EsUsername Text
u) (EsPassword Text
p) = Request -> m Request
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
. Method -> Method -> Request -> Request
applyBasicAuth Method
u' Method
p'
where u' :: Method
u' = Text -> Method
T.encodeUtf8 Text
u
p' :: Method
p' = Text -> Method
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 :: 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))