{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Database.Bloodhound.Client
(
withBH,
createIndex,
createIndexWith,
flushIndex,
deleteIndex,
updateIndexSettings,
getIndexSettings,
forceMergeIndex,
indexExists,
openIndex,
closeIndex,
listIndices,
catIndices,
waitForYellowIndex,
HealthStatus (..),
updateIndexAliases,
getIndexAliases,
deleteIndexAlias,
putTemplate,
templateExists,
deleteTemplate,
putMapping,
indexDocument,
updateDocument,
getDocument,
documentExists,
deleteDocument,
deleteByQuery,
IndexedDocument (..),
DeletedDocuments (..),
DeletedDocumentsRetries (..),
searchAll,
searchByIndex,
searchByIndices,
searchByIndexTemplate,
searchByIndicesTemplate,
scanSearch,
getInitialScroll,
getInitialSortedScroll,
advanceScroll,
pitSearch,
openPointInTime,
closePointInTime,
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,
parseEsResponseWith,
decodeResponse,
eitherDecodeResponse,
countByIndex,
Acknowledged (..),
Accepted (..),
)
where
import Control.Applicative as A
import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Aeson
import Data.Aeson.Key
import qualified Data.Aeson.KeyMap as X
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Foldable (toList)
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 Database.Bloodhound.Internal.Client.BHRequest
import Database.Bloodhound.Types
import Network.HTTP.Client
import qualified Network.HTTP.Types.Method as NHTM
import qualified Network.URI as URI
import Prelude hiding (filter, head)
mkShardCount :: Int -> Maybe ShardCount
mkShardCount :: Int -> Maybe ShardCount
mkShardCount Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. Maybe a
Nothing
| Int
n forall a. Ord a => a -> a -> Bool
> Int
1000 = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (Int -> ShardCount
ShardCount Int
n)
mkReplicaCount :: Int -> Maybe ReplicaCount
mkReplicaCount :: Int -> Maybe ReplicaCount
mkReplicaCount Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. Maybe a
Nothing
| Int
n forall a. Ord a => a -> a -> Bool
> Int
1000 = forall a. Maybe a
Nothing
| Bool
otherwise = 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 =>
BHRequest body ->
m (BHResponse body)
dispatch :: forall (m :: * -> *) body.
MonadBH m =>
BHRequest body -> m (BHResponse body)
dispatch BHRequest body
request = do
BHEnv
env <- forall (m :: * -> *). MonadBH m => m BHEnv
getBHEnv
let url :: Text
url = Server -> Endpoint -> Text
getEndpoint (BHEnv -> Server
bhServer BHEnv
env) (forall responseBody. BHRequest responseBody -> Endpoint
bhRequestEndpoint BHRequest body
request)
Request
initReq <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => Text -> m Request
parseUrl' Text
url
let reqHook :: Request -> IO Request
reqHook = BHEnv -> Request -> IO Request
bhRequestHook BHEnv
env
let reqBody :: RequestBody
reqBody = ByteString -> RequestBody
RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe ByteString
emptyBody forall a b. (a -> b) -> a -> b
$ forall responseBody. BHRequest responseBody -> Maybe ByteString
bhRequestBody BHRequest body
request
Request
req <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
Request -> IO Request
reqHook forall a b. (a -> b) -> a -> b
$
Request -> Request
setRequestIgnoreStatus forall a b. (a -> b) -> a -> b
$
Request
initReq
{ method :: ByteString
method = forall responseBody. BHRequest responseBody -> ByteString
bhRequestMethod BHRequest body
request,
requestHeaders :: RequestHeaders
requestHeaders =
(HeaderName
"Content-Type", ByteString
"application/json") forall a. a -> [a] -> [a]
: Request -> RequestHeaders
requestHeaders Request
initReq,
requestBody :: RequestBody
requestBody = RequestBody
reqBody
}
let mgr :: Manager
mgr = BHEnv -> Manager
bhManager BHEnv
env
forall body. Response ByteString -> BHResponse body
BHResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Request -> Manager -> IO (Response ByteString)
httpLbs Request
req Manager
mgr)
withBH :: ManagerSettings -> Server -> BH IO a -> IO a
withBH :: forall a. ManagerSettings -> Server -> BH IO a -> IO a
withBH ManagerSettings
ms Server
s BH IO a
f = do
Manager
mgr <- ManagerSettings -> IO Manager
newManager ManagerSettings
ms
let env :: BHEnv
env = Server -> Manager -> BHEnv
mkBHEnv Server
s Manager
mgr
forall (m :: * -> *) a. BHEnv -> BH m a -> m a
runBH BHEnv
env BH IO a
f
delete :: MonadBH m => Endpoint -> m (BHResponse body)
delete :: forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete = forall (m :: * -> *) body.
MonadBH m =>
BHRequest body -> m (BHResponse body)
dispatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. ByteString -> Endpoint -> BHRequest body
mkSimpleRequest ByteString
NHTM.methodDelete
deleteWithBody :: MonadBH m => Endpoint -> L.ByteString -> m (BHResponse body)
deleteWithBody :: forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
deleteWithBody Endpoint
endpoint = forall (m :: * -> *) body.
MonadBH m =>
BHRequest body -> m (BHResponse body)
dispatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. ByteString -> Endpoint -> ByteString -> BHRequest body
mkFullRequest ByteString
NHTM.methodDelete Endpoint
endpoint
get :: MonadBH m => Endpoint -> m (BHResponse body)
get :: forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get = forall (m :: * -> *) body.
MonadBH m =>
BHRequest body -> m (BHResponse body)
dispatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. ByteString -> Endpoint -> BHRequest body
mkSimpleRequest ByteString
NHTM.methodGet
head :: MonadBH m => Endpoint -> m (BHResponse body)
head :: forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
head = forall (m :: * -> *) body.
MonadBH m =>
BHRequest body -> m (BHResponse body)
dispatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. ByteString -> Endpoint -> BHRequest body
mkSimpleRequest ByteString
NHTM.methodHead
put :: MonadBH m => Endpoint -> L.ByteString -> m (BHResponse body)
put :: forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put Endpoint
endpoint = forall (m :: * -> *) body.
MonadBH m =>
BHRequest body -> m (BHResponse body)
dispatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. ByteString -> Endpoint -> ByteString -> BHRequest body
mkFullRequest ByteString
NHTM.methodPut Endpoint
endpoint
post :: MonadBH m => Endpoint -> L.ByteString -> m (BHResponse body)
post :: forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post Endpoint
endpoint = forall (m :: * -> *) body.
MonadBH m =>
BHRequest body -> m (BHResponse body)
dispatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. ByteString -> Endpoint -> ByteString -> BHRequest body
mkFullRequest ByteString
NHTM.methodPost Endpoint
endpoint
getStatus :: MonadBH m => m (Either String Status)
getStatus :: forall (m :: * -> *). MonadBH m => m (Either [Char] Status)
getStatus =
forall a. FromJSON a => BHResponse a -> Either [Char] a
eitherDecodeResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get []
getSnapshotRepos ::
( MonadBH m,
MonadThrow m
) =>
SnapshotRepoSelection ->
m (ParsedEsResponse [GenericSnapshotRepo])
getSnapshotRepos :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
SnapshotRepoSelection -> m (ParsedEsResponse [GenericSnapshotRepo])
getSnapshotRepos SnapshotRepoSelection
sel =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GSRs -> [GenericSnapshotRepo]
unGSRs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_snapshot", Text
selectorSeg]
where
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SnapshotRepoPattern
p 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 = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Collection of GenericSnapshotRepo" Object -> Parser GSRs
parse
where
parse :: Object -> Parser GSRs
parse = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [GenericSnapshotRepo] -> GSRs
GSRs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Value -> Parser GenericSnapshotRepo
go) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> [(Key, v)]
X.toList
go :: Key -> Value -> Parser GenericSnapshotRepo
go Key
rawName = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"GenericSnapshotRepo" forall a b. (a -> b) -> a -> b
$ \Object
o ->
SnapshotRepoName
-> SnapshotRepoType
-> GenericSnapshotRepoSettings
-> GenericSnapshotRepo
GenericSnapshotRepo (Text -> SnapshotRepoName
SnapshotRepoName forall a b. (a -> b) -> a -> b
$ Key -> Text
toText Key
rawName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"settings"
updateSnapshotRepo ::
( MonadBH m,
SnapshotRepo repo
) =>
SnapshotRepoUpdateSettings ->
repo ->
m (BHResponse Acknowledged)
updateSnapshotRepo :: forall (m :: * -> *) repo.
(MonadBH m, SnapshotRepo repo) =>
SnapshotRepoUpdateSettings -> repo -> m (BHResponse Acknowledged)
updateSnapshotRepo SnapshotRepoUpdateSettings {Bool
repoUpdateVerify :: SnapshotRepoUpdateSettings -> Bool
repoUpdateVerify :: Bool
..} repo
repo =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put Endpoint
endpoint (forall a. ToJSON a => a -> ByteString
encode Value
body)
where
endpoint :: Endpoint
endpoint = [Text
"_snapshot", SnapshotRepoName -> Text
snapshotRepoName SnapshotRepoName
gSnapshotRepoName] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
params :: [(Text, Maybe Text)]
params
| Bool
repoUpdateVerify = []
| Bool
otherwise = [(Text
"verify", forall a. a -> Maybe a
Just Text
"false")]
body :: Value
body =
[Pair] -> Value
object
[ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SnapshotRepoType
gSnapshotRepoType,
Key
"settings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= GenericSnapshotRepoSettings
gSnapshotRepoSettings
]
GenericSnapshotRepo {GenericSnapshotRepoSettings
SnapshotRepoType
SnapshotRepoName
gSnapshotRepoSettings :: GenericSnapshotRepo -> GenericSnapshotRepoSettings
gSnapshotRepoType :: GenericSnapshotRepo -> SnapshotRepoType
gSnapshotRepoName :: GenericSnapshotRepo -> SnapshotRepoName
gSnapshotRepoSettings :: GenericSnapshotRepoSettings
gSnapshotRepoType :: SnapshotRepoType
gSnapshotRepoName :: SnapshotRepoName
..} = forall r. SnapshotRepo r => r -> GenericSnapshotRepo
toGSnapshotRepo repo
repo
verifySnapshotRepo ::
( MonadBH m,
MonadThrow m
) =>
SnapshotRepoName ->
m (ParsedEsResponse SnapshotVerification)
verifySnapshotRepo :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
SnapshotRepoName -> m (ParsedEsResponse SnapshotVerification)
verifySnapshotRepo (SnapshotRepoName Text
n) =
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
"_snapshot", Text
n, Text
"_verify"] ByteString
emptyBody
deleteSnapshotRepo :: MonadBH m => SnapshotRepoName -> m (BHResponse Acknowledged)
deleteSnapshotRepo :: forall (m :: * -> *).
MonadBH m =>
SnapshotRepoName -> m (BHResponse Acknowledged)
deleteSnapshotRepo (SnapshotRepoName Text
n) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Text
"_snapshot", Text
n]
createSnapshot ::
(MonadBH m) =>
SnapshotRepoName ->
SnapshotName ->
SnapshotCreateSettings ->
m (BHResponse Acknowledged)
createSnapshot :: forall (m :: * -> *).
MonadBH m =>
SnapshotRepoName
-> SnapshotName
-> SnapshotCreateSettings
-> m (BHResponse Acknowledged)
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
..} =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put Endpoint
endpoint ByteString
body
where
endpoint :: Endpoint
endpoint = [Text
"_snapshot", Text
repoName, Text
snapName] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
params :: [(Text, Maybe Text)]
params = [(Text
"wait_for_completion", forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
snapWaitForCompletion))]
body :: ByteString
body = forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Pair]
prs
prs :: [Pair]
prs =
forall a. [Maybe a] -> [a]
catMaybes
[ (Key
"indices" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexSelection -> Text
indexSelectionName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe IndexSelection
snapIndices,
forall a. a -> Maybe a
Just (Key
"ignore_unavailable" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
snapIgnoreUnavailable),
forall a. a -> Maybe a
Just (Key
"ignore_global_state" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
snapIncludeGlobalState),
forall a. a -> Maybe a
Just (Key
"partial" forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IndexName
i 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 (ParsedEsResponse [SnapshotInfo])
getSnapshots :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
SnapshotRepoName
-> SnapshotSelection -> m (ParsedEsResponse [SnapshotInfo])
getSnapshots (SnapshotRepoName Text
repoName) SnapshotSelection
sel =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SIs -> [SnapshotInfo]
unSIs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_snapshot", Text
repoName, Text
snapPath]
where
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SnapshotPattern
s 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 = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"snapshots"
deleteSnapshot :: MonadBH m => SnapshotRepoName -> SnapshotName -> m (BHResponse Acknowledged)
deleteSnapshot :: forall (m :: * -> *).
MonadBH m =>
SnapshotRepoName -> SnapshotName -> m (BHResponse Acknowledged)
deleteSnapshot (SnapshotRepoName Text
repoName) (SnapshotName Text
snapName) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Text
"_snapshot", Text
repoName, Text
snapName]
restoreSnapshot ::
MonadBH m =>
SnapshotRepoName ->
SnapshotName ->
SnapshotRestoreSettings ->
m (BHResponse Accepted)
restoreSnapshot :: forall (m :: * -> *).
MonadBH m =>
SnapshotRepoName
-> SnapshotName
-> SnapshotRestoreSettings
-> m (BHResponse Accepted)
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
..} =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post Endpoint
endpoint (forall a. ToJSON a => a -> ByteString
encode Value
body)
where
endpoint :: Endpoint
endpoint = [Text
"_snapshot", Text
repoName, Text
snapName, Text
"_restore"] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
params :: [(Text, Maybe Text)]
params = [(Text
"wait_for_completion", forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
snapRestoreWaitForCompletion))]
body :: Value
body =
[Pair] -> Value
object forall a b. (a -> b) -> a -> b
$
forall a. [Maybe a] -> [a]
catMaybes
[ (Key
"indices" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexSelection -> Text
indexSelectionName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe IndexSelection
snapRestoreIndices,
forall a. a -> Maybe a
Just (Key
"ignore_unavailable" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
snapRestoreIgnoreUnavailable),
forall a. a -> Maybe a
Just (Key
"include_global_state" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
snapRestoreIncludeGlobalState),
(Key
"rename_pattern" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RestoreRenamePattern
snapRestoreRenamePattern,
(Key
"rename_replacement" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty RestoreRenameToken -> Text
renderTokens forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty RestoreRenameToken)
snapRestoreRenameReplacement,
forall a. a -> Maybe a
Just (Key
"include_aliases" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
snapRestoreIncludeAliases),
(Key
"index_settings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RestoreIndexSettings
snapRestoreIndexSettingsOverrides,
(Key
"ignore_index_settings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) 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) = forall a. Monoid a => [a] -> a
mconcat (RestoreRenameToken -> Text
renderToken forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RestoreRenameToken
t 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 (forall a. Show a => a -> [Char]
show (RRGroupRefNum -> Int
rrGroupRefNum RRGroupRefNum
g))
getNodesInfo ::
( MonadBH m,
MonadThrow m
) =>
NodeSelection ->
m (ParsedEsResponse NodesInfo)
getNodesInfo :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
NodeSelection -> m (ParsedEsResponse NodesInfo)
getNodesInfo NodeSelection
sel =
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_nodes", Text
selectionSeg]
where
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NodeSelector
l 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 forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
v
getNodesStats ::
( MonadBH m,
MonadThrow m
) =>
NodeSelection ->
m (ParsedEsResponse NodesStats)
getNodesStats :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
NodeSelection -> m (ParsedEsResponse NodesStats)
getNodesStats NodeSelection
sel =
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_nodes", Text
selectionSeg, Text
"stats"]
where
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NodeSelector
l 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 forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
v
createIndex :: MonadBH m => IndexSettings -> IndexName -> m (BHResponse Acknowledged)
createIndex :: forall (m :: * -> *).
MonadBH m =>
IndexSettings -> IndexName -> m (BHResponse Acknowledged)
createIndex IndexSettings
indexSettings (IndexName Text
indexName) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put [Text
indexName] forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode IndexSettings
indexSettings
createIndexWith ::
MonadBH m =>
[UpdatableIndexSetting] ->
Int ->
IndexName ->
m (BHResponse Acknowledged)
createIndexWith :: forall (m :: * -> *).
MonadBH m =>
[UpdatableIndexSetting]
-> Int -> IndexName -> m (BHResponse Acknowledged)
createIndexWith [UpdatableIndexSetting]
updates Int
shards (IndexName Text
indexName) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put [Text
indexName] ByteString
body
where
body :: ByteString
body =
forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$
[Pair] -> Value
object
[ Key
"settings"
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Object] -> Object
deepMerge
( forall v. Key -> v -> KeyMap v
X.singleton Key
"index.number_of_shards" (forall a. ToJSON a => a -> Value
toJSON Int
shards)
forall a. a -> [a] -> [a]
: [Object
u | Object Object
u <- forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UpdatableIndexSetting]
updates]
)
]
flushIndex :: MonadBH m => IndexName -> m (BHResponse ShardResult)
flushIndex :: forall (m :: * -> *).
MonadBH m =>
IndexName -> m (BHResponse ShardResult)
flushIndex (IndexName Text
indexName) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
indexName, Text
"_flush"] ByteString
emptyBody
deleteIndex :: MonadBH m => IndexName -> m (BHResponse Acknowledged)
deleteIndex :: forall (m :: * -> *).
MonadBH m =>
IndexName -> m (BHResponse Acknowledged)
deleteIndex (IndexName Text
indexName) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Text
indexName]
updateIndexSettings ::
MonadBH m =>
NonEmpty UpdatableIndexSetting ->
IndexName ->
m (BHResponse Acknowledged)
updateIndexSettings :: forall (m :: * -> *).
MonadBH m =>
NonEmpty UpdatableIndexSetting
-> IndexName -> m (BHResponse Acknowledged)
updateIndexSettings NonEmpty UpdatableIndexSetting
updates (IndexName Text
indexName) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put [Text
indexName, Text
"_settings"] (forall a. ToJSON a => a -> ByteString
encode Value
body)
where
body :: Value
body = Object -> Value
Object ([Object] -> Object
deepMerge [Object
u | Object Object
u <- forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty UpdatableIndexSetting
updates])
getIndexSettings ::
(MonadBH m, MonadThrow m) =>
IndexName ->
m (ParsedEsResponse IndexSettingsSummary)
getIndexSettings :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
IndexName -> m (ParsedEsResponse IndexSettingsSummary)
getIndexSettings (IndexName Text
indexName) =
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
indexName, Text
"_settings"]
forceMergeIndex :: MonadBH m => IndexSelection -> ForceMergeIndexSettings -> m (BHResponse ShardCount)
forceMergeIndex :: forall (m :: * -> *).
MonadBH m =>
IndexSelection
-> ForceMergeIndexSettings -> m (BHResponse ShardCount)
forceMergeIndex IndexSelection
ixs ForceMergeIndexSettings {Bool
Maybe Int
flushAfterOptimize :: ForceMergeIndexSettings -> Bool
onlyExpungeDeletes :: ForceMergeIndexSettings -> Bool
maxNumSegments :: ForceMergeIndexSettings -> Maybe Int
flushAfterOptimize :: Bool
onlyExpungeDeletes :: Bool
maxNumSegments :: Maybe Int
..} =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post Endpoint
endpoint ByteString
emptyBody
where
endpoint :: Endpoint
endpoint = [Text
indexName, Text
"_forcemerge"] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
params :: [(Text, Maybe Text)]
params =
forall a. [Maybe a] -> [a]
catMaybes
[ (Text
"max_num_segments",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
showText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maxNumSegments,
forall a. a -> Maybe a
Just (Text
"only_expunge_deletes", forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
onlyExpungeDeletes)),
forall a. a -> Maybe a
Just (Text
"flush", forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
flushAfterOptimize))
]
indexName :: Text
indexName = IndexSelection -> Text
indexSelectionName IndexSelection
ixs
deepMerge :: [Object] -> Object
deepMerge :: [Object] -> Object
deepMerge = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
LS.foldl' (forall v. (v -> v -> v) -> KeyMap v -> KeyMap v -> KeyMap v
X.unionWith Value -> Value -> Value
merge) forall a. Monoid a => a
mempty
where
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
doesExist :: MonadBH m => Endpoint -> m Bool
doesExist :: forall (m :: * -> *). MonadBH m => Endpoint -> m Bool
doesExist Endpoint
endpoint =
forall a. BHResponse a -> Bool
isSuccess forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
head Endpoint
endpoint
indexExists :: MonadBH m => IndexName -> m Bool
indexExists :: forall (m :: * -> *). MonadBH m => IndexName -> m Bool
indexExists (IndexName Text
indexName) =
forall (m :: * -> *). MonadBH m => Endpoint -> m Bool
doesExist [Text
indexName]
refreshIndex :: MonadBH m => IndexName -> m (BHResponse ShardResult)
refreshIndex :: forall (m :: * -> *).
MonadBH m =>
IndexName -> m (BHResponse ShardResult)
refreshIndex (IndexName Text
indexName) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
indexName, Text
"_refresh"] ByteString
emptyBody
waitForYellowIndex :: MonadBH m => IndexName -> m (BHResponse HealthStatus)
waitForYellowIndex :: forall (m :: * -> *).
MonadBH m =>
IndexName -> m (BHResponse HealthStatus)
waitForYellowIndex (IndexName Text
indexName) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get Endpoint
endpoint
where
endpoint :: Endpoint
endpoint = [Text
"_cluster", Text
"health", Text
indexName] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
params :: [(Text, Maybe Text)]
params = [(Text
"wait_for_status", forall a. a -> Maybe a
Just Text
"yellow"), (Text
"timeout", forall a. a -> Maybe a
Just Text
"10s")]
data HealthStatus = HealthStatus
{ HealthStatus -> Text
healthStatusClusterName :: Text,
HealthStatus -> Text
healthStatusStatus :: Text,
HealthStatus -> Bool
healthStatusTimedOut :: Bool,
HealthStatus -> Int
healthStatusNumberOfNodes :: Int,
HealthStatus -> Int
healthStatusNumberOfDataNodes :: Int,
HealthStatus -> Int
healthStatusActivePrimaryShards :: Int,
HealthStatus -> Int
healthStatusActiveShards :: Int,
HealthStatus -> Int
healthStatusRelocatingShards :: Int,
HealthStatus -> Int
healthStatusInitializingShards :: Int,
HealthStatus -> Int
healthStatusUnassignedShards :: Int,
HealthStatus -> Int
healthStatusDelayedUnassignedShards :: Int,
HealthStatus -> Int
healthStatusNumberOfPendingTasks :: Int,
HealthStatus -> Int
healthStatusNumberOfInFlightFetch :: Int,
HealthStatus -> Int
healthStatusTaskMaxWaitingInQueueMillis :: Int,
HealthStatus -> Float
healthStatusActiveShardsPercentAsNumber :: Float
}
deriving stock (HealthStatus -> HealthStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HealthStatus -> HealthStatus -> Bool
$c/= :: HealthStatus -> HealthStatus -> Bool
== :: HealthStatus -> HealthStatus -> Bool
$c== :: HealthStatus -> HealthStatus -> Bool
Eq, Int -> HealthStatus -> ShowS
[HealthStatus] -> ShowS
HealthStatus -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HealthStatus] -> ShowS
$cshowList :: [HealthStatus] -> ShowS
show :: HealthStatus -> [Char]
$cshow :: HealthStatus -> [Char]
showsPrec :: Int -> HealthStatus -> ShowS
$cshowsPrec :: Int -> HealthStatus -> ShowS
Show)
instance FromJSON HealthStatus where
parseJSON :: Value -> Parser HealthStatus
parseJSON =
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HealthStatus" forall a b. (a -> b) -> a -> b
$ \Object
v ->
Text
-> Text
-> Bool
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Float
-> HealthStatus
HealthStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cluster_name"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timed_out"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number_of_nodes"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number_of_data_nodes"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active_primary_shards"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active_shards"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"relocating_shards"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"initializing_shards"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"unassigned_shards"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"delayed_unassigned_shards"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number_of_pending_tasks"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number_of_in_flight_fetch"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"task_max_waiting_in_queue_millis"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active_shards_percent_as_number"
openOrCloseIndexes :: MonadBH m => OpenCloseIndex -> IndexName -> m (BHResponse Acknowledged)
openOrCloseIndexes :: forall (m :: * -> *).
MonadBH m =>
OpenCloseIndex -> IndexName -> m (BHResponse Acknowledged)
openOrCloseIndexes OpenCloseIndex
oci (IndexName Text
indexName) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
indexName, Text
stringifyOCIndex] ByteString
emptyBody
where
stringifyOCIndex :: Text
stringifyOCIndex = case OpenCloseIndex
oci of
OpenCloseIndex
OpenIndex -> Text
"_open"
OpenCloseIndex
CloseIndex -> Text
"_close"
openIndex :: MonadBH m => IndexName -> m (BHResponse Acknowledged)
openIndex :: forall (m :: * -> *).
MonadBH m =>
IndexName -> m (BHResponse Acknowledged)
openIndex = forall (m :: * -> *).
MonadBH m =>
OpenCloseIndex -> IndexName -> m (BHResponse Acknowledged)
openOrCloseIndexes OpenCloseIndex
OpenIndex
closeIndex :: MonadBH m => IndexName -> m (BHResponse Acknowledged)
closeIndex :: forall (m :: * -> *).
MonadBH m =>
IndexName -> m (BHResponse Acknowledged)
closeIndex = forall (m :: * -> *).
MonadBH m =>
OpenCloseIndex -> IndexName -> m (BHResponse Acknowledged)
openOrCloseIndexes OpenCloseIndex
CloseIndex
listIndices :: (MonadThrow m, MonadBH m) => m [IndexName]
listIndices :: forall (m :: * -> *). (MonadThrow m, MonadBH m) => m [IndexName]
listIndices =
forall (m :: * -> *) body parsed.
(MonadThrow m, FromJSON body) =>
(body -> Either [Char] parsed) -> BHResponse body -> m parsed
parseEsResponseWith [Value] -> Either [Char] [IndexName]
parser forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_cat/indices?format=json"]
where
parser :: [Value] -> Either String [IndexName]
parser :: [Value] -> Either [Char] [IndexName]
parser =
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a b. (a -> b) -> a -> b
$ \Value
val ->
case Value
val of
Object Object
obj ->
case forall v. Key -> KeyMap v -> Maybe v
X.lookup Key
"index" Object
obj of
(Just (String Text
txt)) -> forall a b. b -> Either a b
Right (Text -> IndexName
IndexName Text
txt)
Maybe Value
v -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"indexVal in listIndices failed on non-string, was: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Maybe Value
v
Value
v -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"One of the values parsed in listIndices wasn't an object, it was: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Value
v
catIndices :: (MonadThrow m, MonadBH m) => m [(IndexName, Int)]
catIndices :: forall (m :: * -> *).
(MonadThrow m, MonadBH m) =>
m [(IndexName, Int)]
catIndices =
forall (m :: * -> *) body parsed.
(MonadThrow m, FromJSON body) =>
(body -> Either [Char] parsed) -> BHResponse body -> m parsed
parseEsResponseWith [Value] -> Either [Char] [(IndexName, Int)]
parser forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_cat/indices?format=json"]
where
parser :: [Value] -> Either String [(IndexName, Int)]
parser :: [Value] -> Either [Char] [(IndexName, Int)]
parser =
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a b. (a -> b) -> a -> b
$ \Value
val ->
case Value
val of
Object Object
obj ->
case (forall v. Key -> KeyMap v -> Maybe v
X.lookup Key
"index" Object
obj, forall v. Key -> KeyMap v -> Maybe v
X.lookup Key
"docs.count" Object
obj) of
(Just (String Text
txt), Just (String Text
docs)) -> forall a b. b -> Either a b
Right (Text -> IndexName
IndexName Text
txt, forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
docs))
(Maybe Value, Maybe Value)
v -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"indexVal in catIndices failed on non-string, was: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (Maybe Value, Maybe Value)
v
Value
v -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"One of the values parsed in catIndices wasn't an object, it was: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Value
v
updateIndexAliases :: MonadBH m => NonEmpty IndexAliasAction -> m (BHResponse Acknowledged)
updateIndexAliases :: forall (m :: * -> *).
MonadBH m =>
NonEmpty IndexAliasAction -> m (BHResponse Acknowledged)
updateIndexAliases NonEmpty IndexAliasAction
actions =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
"_aliases"] (forall a. ToJSON a => a -> ByteString
encode Value
body)
where
body :: Value
body = [Pair] -> Value
object [Key
"actions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexAliasAction
actions]
getIndexAliases ::
(MonadBH m, MonadThrow m) =>
m (ParsedEsResponse IndexAliasesSummary)
getIndexAliases :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
m (ParsedEsResponse IndexAliasesSummary)
getIndexAliases =
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_aliases"]
deleteIndexAlias :: MonadBH m => IndexAliasName -> m (BHResponse Acknowledged)
deleteIndexAlias :: forall (m :: * -> *).
MonadBH m =>
IndexAliasName -> m (BHResponse Acknowledged)
deleteIndexAlias (IndexAliasName (IndexName Text
name)) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Text
"_all", Text
"_alias", Text
name]
putTemplate :: MonadBH m => IndexTemplate -> TemplateName -> m (BHResponse Acknowledged)
putTemplate :: forall (m :: * -> *).
MonadBH m =>
IndexTemplate -> TemplateName -> m (BHResponse Acknowledged)
putTemplate IndexTemplate
indexTemplate (TemplateName Text
templateName) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put [Text
"_template", Text
templateName] (forall a. ToJSON a => a -> ByteString
encode IndexTemplate
indexTemplate)
templateExists :: MonadBH m => TemplateName -> m Bool
templateExists :: forall (m :: * -> *). MonadBH m => TemplateName -> m Bool
templateExists (TemplateName Text
templateName) =
forall (m :: * -> *). MonadBH m => Endpoint -> m Bool
doesExist [Text
"_template", Text
templateName]
deleteTemplate :: MonadBH m => TemplateName -> m (BHResponse Acknowledged)
deleteTemplate :: forall (m :: * -> *).
MonadBH m =>
TemplateName -> m (BHResponse Acknowledged)
deleteTemplate (TemplateName Text
templateName) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Text
"_template", Text
templateName]
putMapping :: (MonadBH m, ToJSON a) => IndexName -> a -> m (BHResponse a)
putMapping :: forall (m :: * -> *) a.
(MonadBH m, ToJSON a) =>
IndexName -> a -> m (BHResponse a)
putMapping (IndexName Text
indexName) a
mapping =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put [Text
indexName, Text
"_mapping"] (forall a. ToJSON a => a -> ByteString
encode a
mapping)
{-# DEPRECATED putMapping "See <https://www.elastic.co/guide/en/elasticsearch/reference/7.17/removal-of-types.html>" #-}
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)]
versionParams DocVersion
v Text
"internal"
ExternalGT (ExternalDocVersion DocVersion
v) -> DocVersion -> Text -> [(Text, Maybe Text)]
versionParams DocVersion
v Text
"external_gt"
ExternalGTE (ExternalDocVersion DocVersion
v) -> DocVersion -> Text -> [(Text, Maybe Text)]
versionParams DocVersion
v Text
"external_gte"
ForceVersion (ExternalDocVersion DocVersion
v) -> DocVersion -> Text -> [(Text, Maybe Text)]
versionParams DocVersion
v Text
"force"
where
vt :: DocVersion -> Text
vt = forall a. Show a => a -> Text
showText forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocVersion -> Int
docVersionNumber
versionParams :: DocVersion -> Text -> [(Text, Maybe Text)]
versionParams :: DocVersion -> Text -> [(Text, Maybe Text)]
versionParams DocVersion
v Text
t =
[ (Text
"version", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ DocVersion -> Text
vt DocVersion
v),
(Text
"version_type", forall a. a -> Maybe a
Just Text
t)
]
indexDocument ::
(ToJSON doc, MonadBH m) =>
IndexName ->
IndexDocumentSettings ->
doc ->
DocId ->
m (BHResponse IndexedDocument)
indexDocument :: forall doc (m :: * -> *).
(ToJSON doc, MonadBH m) =>
IndexName
-> IndexDocumentSettings
-> doc
-> DocId
-> m (BHResponse IndexedDocument)
indexDocument (IndexName Text
indexName) IndexDocumentSettings
cfg doc
document (DocId Text
docId) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put Endpoint
endpoint (forall a. ToJSON a => a -> ByteString
encode Value
body)
where
endpoint :: Endpoint
endpoint = [Text
indexName, Text
"_doc", Text
docId] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` IndexDocumentSettings -> DocId -> [(Text, Maybe Text)]
indexQueryString IndexDocumentSettings
cfg (Text -> DocId
DocId Text
docId)
body :: Value
body = forall doc. ToJSON doc => IndexDocumentSettings -> doc -> Value
encodeDocument IndexDocumentSettings
cfg doc
document
data IndexedDocument = IndexedDocument
{ IndexedDocument -> Text
idxDocIndex :: Text,
IndexedDocument -> Text
idxDocType :: Text,
IndexedDocument -> Text
idxDocId :: Text,
IndexedDocument -> Int
idxDocVersion :: Int,
IndexedDocument -> Text
idxDocResult :: Text,
IndexedDocument -> ShardResult
idxDocShards :: ShardResult,
IndexedDocument -> Int
idxDocSeqNo :: Int,
IndexedDocument -> Int
idxDocPrimaryTerm :: Int
}
deriving stock (IndexedDocument -> IndexedDocument -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDocument -> IndexedDocument -> Bool
$c/= :: IndexedDocument -> IndexedDocument -> Bool
== :: IndexedDocument -> IndexedDocument -> Bool
$c== :: IndexedDocument -> IndexedDocument -> Bool
Eq, Int -> IndexedDocument -> ShowS
[IndexedDocument] -> ShowS
IndexedDocument -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [IndexedDocument] -> ShowS
$cshowList :: [IndexedDocument] -> ShowS
show :: IndexedDocument -> [Char]
$cshow :: IndexedDocument -> [Char]
showsPrec :: Int -> IndexedDocument -> ShowS
$cshowsPrec :: Int -> IndexedDocument -> ShowS
Show)
instance FromJSON IndexedDocument where
parseJSON :: Value -> Parser IndexedDocument
parseJSON =
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"IndexedDocument" forall a b. (a -> b) -> a -> b
$ \Object
v ->
Text
-> Text
-> Text
-> Int
-> Text
-> ShardResult
-> Int
-> Int
-> IndexedDocument
IndexedDocument
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_index"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_type"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_id"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_version"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"result"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_shards"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_seq_no"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_primary_term"
updateDocument ::
(ToJSON patch, MonadBH m) =>
IndexName ->
IndexDocumentSettings ->
patch ->
DocId ->
m (BHResponse IndexedDocument)
updateDocument :: forall doc (m :: * -> *).
(ToJSON doc, MonadBH m) =>
IndexName
-> IndexDocumentSettings
-> doc
-> DocId
-> m (BHResponse IndexedDocument)
updateDocument (IndexName Text
indexName) IndexDocumentSettings
cfg patch
patch (DocId Text
docId) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post Endpoint
endpoint (forall a. ToJSON a => a -> ByteString
encode Value
body)
where
endpoint :: Endpoint
endpoint = [Text
indexName, Text
"_update", Text
docId] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` IndexDocumentSettings -> DocId -> [(Text, Maybe Text)]
indexQueryString IndexDocumentSettings
cfg (Text -> DocId
DocId Text
docId)
body :: Value
body = [Pair] -> Value
object [Key
"doc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall doc. ToJSON doc => IndexDocumentSettings -> doc -> Value
encodeDocument IndexDocumentSettings
cfg patch
patch]
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 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", forall a. a -> Maybe a
Just Text
docId)]
Just (ChildDocument FieldName
_ RelationName
_ (DocId Text
pid)) -> [(Text
"routing", forall a. a -> Maybe a
Just Text
pid)]
encodeDocument :: ToJSON doc => IndexDocumentSettings -> doc -> Value
encodeDocument :: forall doc. ToJSON doc => IndexDocumentSettings -> doc -> Value
encodeDocument IndexDocumentSettings
cfg doc
document =
case IndexDocumentSettings -> Maybe JoinRelation
idsJoinRelation IndexDocumentSettings
cfg of
Maybe JoinRelation
Nothing -> forall a. ToJSON a => a -> Value
toJSON doc
document
Just (ParentDocument (FieldName Text
field) RelationName
name) ->
Value -> Value -> Value
mergeObjects (forall a. ToJSON a => a -> Value
toJSON doc
document) ([Pair] -> Value
object [Text -> Key
fromText Text
field forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RelationName
name])
Just (ChildDocument (FieldName Text
field) RelationName
name DocId
parent) ->
Value -> Value -> Value
mergeObjects (forall a. ToJSON a => a -> Value
toJSON doc
document) ([Pair] -> Value
object [Text -> Key
fromText Text
field forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RelationName
name, Key
"parent" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DocId
parent]])
where
mergeObjects :: Value -> Value -> Value
mergeObjects (Object Object
a) (Object Object
b) = Object -> Value
Object (Object
a forall a. Semigroup a => a -> a -> a
<> Object
b)
mergeObjects Value
_ 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 (BHResponse IndexedDocument)
deleteDocument :: forall (m :: * -> *).
MonadBH m =>
IndexName -> DocId -> m (BHResponse IndexedDocument)
deleteDocument (IndexName Text
indexName) (DocId Text
docId) = forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Text
indexName, Text
"_doc", Text
docId]
deleteByQuery :: MonadBH m => IndexName -> Query -> m (BHResponse DeletedDocuments)
deleteByQuery :: forall (m :: * -> *).
MonadBH m =>
IndexName -> Query -> m (BHResponse DeletedDocuments)
deleteByQuery (IndexName Text
indexName) Query
query =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
indexName, Text
"_delete_by_query"] (forall a. ToJSON a => a -> ByteString
encode Value
body)
where
body :: Value
body = [Pair] -> Value
object [Key
"query" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Query
query]
data DeletedDocuments = DeletedDocuments
{ DeletedDocuments -> Int
delDocsTook :: Int,
DeletedDocuments -> Bool
delDocsTimedOut :: Bool,
DeletedDocuments -> Int
delDocsTotal :: Int,
DeletedDocuments -> Int
delDocsDeleted :: Int,
DeletedDocuments -> Int
delDocsBatches :: Int,
DeletedDocuments -> Int
delDocsVersionConflicts :: Int,
DeletedDocuments -> Int
delDocsNoops :: Int,
DeletedDocuments -> DeletedDocumentsRetries
delDocsRetries :: DeletedDocumentsRetries,
DeletedDocuments -> Int
delDocsThrottledMillis :: Int,
DeletedDocuments -> Float
delDocsRequestsPerSecond :: Float,
DeletedDocuments -> Int
delDocsThrottledUntilMillis :: Int,
DeletedDocuments -> [Value]
delDocsFailures :: [Value]
}
deriving stock (DeletedDocuments -> DeletedDocuments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletedDocuments -> DeletedDocuments -> Bool
$c/= :: DeletedDocuments -> DeletedDocuments -> Bool
== :: DeletedDocuments -> DeletedDocuments -> Bool
$c== :: DeletedDocuments -> DeletedDocuments -> Bool
Eq, Int -> DeletedDocuments -> ShowS
[DeletedDocuments] -> ShowS
DeletedDocuments -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DeletedDocuments] -> ShowS
$cshowList :: [DeletedDocuments] -> ShowS
show :: DeletedDocuments -> [Char]
$cshow :: DeletedDocuments -> [Char]
showsPrec :: Int -> DeletedDocuments -> ShowS
$cshowsPrec :: Int -> DeletedDocuments -> ShowS
Show)
instance FromJSON DeletedDocuments where
parseJSON :: Value -> Parser DeletedDocuments
parseJSON =
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"DeletedDocuments" forall a b. (a -> b) -> a -> b
$ \Object
v ->
Int
-> Bool
-> Int
-> Int
-> Int
-> Int
-> Int
-> DeletedDocumentsRetries
-> Int
-> Float
-> Int
-> [Value]
-> DeletedDocuments
DeletedDocuments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"took"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timed_out"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deleted"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"batches"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version_conflicts"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"noops"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"retries"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"throttled_millis"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"requests_per_second"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"throttled_until_millis"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"failures"
data DeletedDocumentsRetries = DeletedDocumentsRetries
{ DeletedDocumentsRetries -> Int
delDocsRetriesBulk :: Int,
DeletedDocumentsRetries -> Int
delDocsRetriesSearch :: Int
}
deriving stock (DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
$c/= :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
== :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
$c== :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
Eq, Int -> DeletedDocumentsRetries -> ShowS
[DeletedDocumentsRetries] -> ShowS
DeletedDocumentsRetries -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DeletedDocumentsRetries] -> ShowS
$cshowList :: [DeletedDocumentsRetries] -> ShowS
show :: DeletedDocumentsRetries -> [Char]
$cshow :: DeletedDocumentsRetries -> [Char]
showsPrec :: Int -> DeletedDocumentsRetries -> ShowS
$cshowsPrec :: Int -> DeletedDocumentsRetries -> ShowS
Show)
instance FromJSON DeletedDocumentsRetries where
parseJSON :: Value -> Parser DeletedDocumentsRetries
parseJSON =
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"DeletedDocumentsRetries" forall a b. (a -> b) -> a -> b
$ \Object
v ->
Int -> Int -> DeletedDocumentsRetries
DeletedDocumentsRetries
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bulk"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"search"
bulk :: MonadBH m => V.Vector BulkOperation -> m (BHResponse a)
bulk :: forall (m :: * -> *) a.
MonadBH m =>
Vector BulkOperation -> m (BHResponse a)
bulk =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
"_bulk"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector BulkOperation -> ByteString
encodeBulkOperations
encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
encodeBulkOperations :: Vector BulkOperation -> ByteString
encodeBulkOperations Vector BulkOperation
stream = ByteString
collapsed
where
blobs :: Vector ByteString
blobs =
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 (forall a. Monoid a => a
mempty :: Builder) Vector ByteString
blobs
collapsed :: ByteString
collapsed =
Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a -> a -> a
mappend Builder
mashedTaters (ByteString -> Builder
byteString ByteString
"\n")
mash :: Builder -> V.Vector L.ByteString -> Builder
mash :: Builder -> Vector ByteString -> Builder
mash = forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' (\Builder
b ByteString
x -> Builder
b forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
"\n" 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 =
[Pair] -> Value
object
[ Text -> Key
fromText Text
operation
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
[ Key
"_index" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
indexName,
Key
"_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
docId
]
]
mkBulkStreamValueAuto :: Text -> Text -> Value
mkBulkStreamValueAuto :: Text -> Text -> Value
mkBulkStreamValueAuto Text
operation Text
indexName =
[Pair] -> Value
object
[ Text -> Key
fromText Text
operation
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"_index" forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 =
[Pair] -> Value
object
[ Text -> Key
fromText Text
operation
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
( [ Key
"_index" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
indexName,
Key
"_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
docId
]
forall a. Semigroup a => a -> a -> a
<> (UpsertActionMetadata -> Pair
buildUpsertActionMetadata 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 = forall a. ToJSON a => a -> ByteString
encode Value
metadata forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" forall a. Monoid a => a -> a -> a
`mappend` 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 = forall a. ToJSON a => a -> ByteString
encode Value
metadata forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" forall a. Monoid a => a -> a -> a
`mappend` 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 = forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Text -> Value
mkBulkStreamValueAuto Text
"index" Text
indexName)
blob :: Builder
blob = forall tag. Encoding' tag -> Builder
fromEncoding Encoding
metadata forall a. Semigroup a => a -> a -> a
<> Builder
"\n" forall a. Semigroup a => a -> a -> a
<> 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 = forall a. ToJSON a => a -> ByteString
encode Value
metadata forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" forall a. Monoid a => a -> a -> a
`mappend` 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 = 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 = [Pair] -> Value
object [Key
"doc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
value]
blob :: ByteString
blob = forall a. ToJSON a => a -> ByteString
encode Value
metadata forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" forall a. Monoid a => a -> a -> a
`mappend` 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 = forall a. ToJSON a => a -> ByteString
encode Value
metadata forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" forall a. Semigroup a => a -> a -> a
<> forall a. ToJSON a => a -> ByteString
encode Value
doc
doc :: Value
doc = case UpsertPayload
payload of
UpsertDoc Value
value -> [Pair] -> Value
object [Key
"doc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
value, Key
"doc_as_upsert" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True]
UpsertScript Bool
scriptedUpsert Script
script Value
value ->
let scup :: [Pair]
scup = if Bool
scriptedUpsert then [Key
"scripted_upsert" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True] else []
upsert :: [Pair]
upsert = [Key
"upsert" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
value]
in case ([Pair] -> Value
object ([Pair]
scup forall a. Semigroup a => a -> a -> a
<> [Pair]
upsert), forall a. ToJSON a => a -> Value
toJSON Script
script) of
(Object Object
obj, Object Object
jscript) -> Object -> Value
Object forall a b. (a -> b) -> a -> b
$ Object
jscript forall a. Semigroup a => a -> a -> a
<> Object
obj
(Value, 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 = forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Text -> Text -> Value
mkBulkStreamValue Text
"create" Text
indexName Text
docId)
blob :: Builder
blob = forall tag. Encoding' tag -> Builder
fromEncoding Encoding
metadata forall a. Semigroup a => a -> a -> a
<> Builder
"\n" forall a. Semigroup a => a -> a -> a
<> forall tag. Encoding' tag -> Builder
fromEncoding Encoding
encoding
getDocument :: (FromJSON a, MonadBH m) => IndexName -> DocId -> m (BHResponse (EsResult a))
getDocument :: forall a (m :: * -> *).
(FromJSON a, MonadBH m) =>
IndexName -> DocId -> m (BHResponse (EsResult a))
getDocument (IndexName Text
indexName) (DocId Text
docId) =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
indexName, Text
"_doc", Text
docId]
documentExists :: MonadBH m => IndexName -> DocId -> m Bool
documentExists :: forall (m :: * -> *). MonadBH m => IndexName -> DocId -> m Bool
documentExists (IndexName Text
indexName) (DocId Text
docId) =
forall (m :: * -> *). MonadBH m => Endpoint -> m Bool
doesExist [Text
indexName, Text
"_doc", Text
docId]
dispatchSearch :: MonadBH m => Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch :: forall (m :: * -> *) a.
MonadBH m =>
Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch Endpoint
endpoint Search
search = forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post Endpoint
url' (forall a. ToJSON a => a -> ByteString
encode Search
search)
where
url' :: Endpoint
url' = Endpoint -> SearchType -> Endpoint
appendSearchTypeParam Endpoint
endpoint (Search -> SearchType
searchType Search
search)
appendSearchTypeParam :: Endpoint -> SearchType -> Endpoint
appendSearchTypeParam :: Endpoint -> SearchType -> Endpoint
appendSearchTypeParam Endpoint
originalUrl SearchType
st = Endpoint
originalUrl Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
where
stText :: Text
stText = Text
"search_type"
params :: [(Text, Maybe Text)]
params
| SearchType
st forall a. Eq a => a -> a -> Bool
== SearchType
SearchTypeDfsQueryThenFetch = [(Text
stText, forall a. a -> Maybe a
Just Text
"dfs_query_then_fetch")]
| Bool
otherwise = []
searchAll :: MonadBH m => Search -> m (BHResponse (SearchResult a))
searchAll :: forall (m :: * -> *) a.
MonadBH m =>
Search -> m (BHResponse (SearchResult a))
searchAll = forall (m :: * -> *) a.
MonadBH m =>
Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch [Text
"_search"]
searchByIndex :: MonadBH m => IndexName -> Search -> m (BHResponse (SearchResult a))
searchByIndex :: forall (m :: * -> *) a.
MonadBH m =>
IndexName -> Search -> m (BHResponse (SearchResult a))
searchByIndex (IndexName Text
indexName) = forall (m :: * -> *) a.
MonadBH m =>
Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch [Text
indexName, Text
"_search"]
searchByIndices :: MonadBH m => NonEmpty IndexName -> Search -> m (BHResponse (SearchResult a))
searchByIndices :: forall (m :: * -> *) a.
MonadBH m =>
NonEmpty IndexName -> Search -> m (BHResponse (SearchResult a))
searchByIndices NonEmpty IndexName
ixs = forall (m :: * -> *) a.
MonadBH m =>
Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch [Text
renderedIxs, Text
"_search"]
where
renderedIxs :: Text
renderedIxs = Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
',') (forall a b. (a -> b) -> [a] -> [b]
map (\(IndexName Text
t) -> Text
t) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexName
ixs))
dispatchSearchTemplate ::
(FromJSON a, MonadBH m) =>
Endpoint ->
SearchTemplate ->
m (BHResponse (SearchResult a))
dispatchSearchTemplate :: forall a (m :: * -> *).
(FromJSON a, MonadBH m) =>
Endpoint -> SearchTemplate -> m (BHResponse (SearchResult a))
dispatchSearchTemplate Endpoint
endpoint SearchTemplate
search = forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post Endpoint
endpoint forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode SearchTemplate
search
searchByIndexTemplate ::
(FromJSON a, MonadBH m) =>
IndexName ->
SearchTemplate ->
m (BHResponse (SearchResult a))
searchByIndexTemplate :: forall a (m :: * -> *).
(FromJSON a, MonadBH m) =>
IndexName -> SearchTemplate -> m (BHResponse (SearchResult a))
searchByIndexTemplate (IndexName Text
indexName) = forall a (m :: * -> *).
(FromJSON a, MonadBH m) =>
Endpoint -> SearchTemplate -> m (BHResponse (SearchResult a))
dispatchSearchTemplate [Text
indexName, Text
"_search", Text
"template"]
searchByIndicesTemplate ::
(FromJSON a, MonadBH m) =>
NonEmpty IndexName ->
SearchTemplate ->
m (BHResponse (SearchResult a))
searchByIndicesTemplate :: forall a (m :: * -> *).
(FromJSON a, MonadBH m) =>
NonEmpty IndexName
-> SearchTemplate -> m (BHResponse (SearchResult a))
searchByIndicesTemplate NonEmpty IndexName
ixs = forall a (m :: * -> *).
(FromJSON a, MonadBH m) =>
Endpoint -> SearchTemplate -> m (BHResponse (SearchResult a))
dispatchSearchTemplate [Text
renderedIxs, Text
"_search", Text
"template"]
where
renderedIxs :: Text
renderedIxs = Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
',') (forall a b. (a -> b) -> [a] -> [b]
map (\(IndexName Text
t) -> Text
t) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexName
ixs))
storeSearchTemplate :: MonadBH m => SearchTemplateId -> SearchTemplateSource -> m (BHResponse Acknowledged)
storeSearchTemplate :: forall (m :: * -> *).
MonadBH m =>
SearchTemplateId
-> SearchTemplateSource -> m (BHResponse Acknowledged)
storeSearchTemplate (SearchTemplateId Text
tid) SearchTemplateSource
ts =
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
"_scripts", Text
tid] (forall a. ToJSON a => a -> ByteString
encode Value
body)
where
body :: Value
body = Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. [(Key, v)] -> KeyMap v
X.fromList [Key
"script" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Object -> Value
Object (Key
"lang" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"mustache" forall a. Semigroup a => a -> a -> a
<> Key
"source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SearchTemplateSource
ts)]
getSearchTemplate :: MonadBH m => SearchTemplateId -> m (BHResponse GetTemplateScript)
getSearchTemplate :: forall (m :: * -> *).
MonadBH m =>
SearchTemplateId -> m (BHResponse GetTemplateScript)
getSearchTemplate (SearchTemplateId Text
tid) = forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_scripts", Text
tid]
deleteSearchTemplate :: MonadBH m => SearchTemplateId -> m (BHResponse Acknowledged)
deleteSearchTemplate :: forall (m :: * -> *).
MonadBH m =>
SearchTemplateId -> m (BHResponse Acknowledged)
deleteSearchTemplate (SearchTemplateId Text
tid) = forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Text
"_scripts", Text
tid]
getInitialScroll ::
(FromJSON a, MonadThrow m, MonadBH m) =>
IndexName ->
Search ->
m (ParsedEsResponse (SearchResult a))
getInitialScroll :: forall a (m :: * -> *).
(FromJSON a, MonadThrow m, MonadBH m) =>
IndexName -> Search -> m (ParsedEsResponse (SearchResult a))
getInitialScroll (IndexName Text
indexName) Search
search' =
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a.
MonadBH m =>
Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch Endpoint
endpoint Search
search
where
endpoint :: Endpoint
endpoint = [Text
indexName, Text
"_search"] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text
"scroll", forall a. a -> Maybe a
Just Text
"1m")]
sorting :: Maybe Sort
sorting = forall a. a -> Maybe a
Just [DefaultSort -> SortSpec
DefaultSortSpec 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 Sort
sortBody = Maybe Sort
sorting}
getInitialSortedScroll ::
(FromJSON a, MonadThrow m, MonadBH m) =>
IndexName ->
Search ->
m (ParsedEsResponse (SearchResult a))
getInitialSortedScroll :: forall a (m :: * -> *).
(FromJSON a, MonadThrow m, MonadBH m) =>
IndexName -> Search -> m (ParsedEsResponse (SearchResult a))
getInitialSortedScroll (IndexName Text
indexName) Search
search = do
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a.
MonadBH m =>
Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch Endpoint
endpoint Search
search
where
endpoint :: Endpoint
endpoint = [Text
indexName, Text
"_search"] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text
"scroll", forall a. a -> Maybe a
Just Text
"1m")]
scroll' ::
(FromJSON a, MonadBH m, MonadThrow m) =>
Maybe ScrollId ->
m ([Hit a], Maybe ScrollId)
scroll' :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
scroll' Maybe ScrollId
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. Maybe a
Nothing)
scroll' (Just ScrollId
sid) = do
ParsedEsResponse (SearchResult a)
res <- forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
ScrollId
-> NominalDiffTime -> m (ParsedEsResponse (SearchResult a))
advanceScroll ScrollId
sid NominalDiffTime
60
case ParsedEsResponse (SearchResult a)
res of
Right SearchResult {Bool
Int
Maybe Text
Maybe AggregationResults
Maybe NamedSuggestionResponse
Maybe ScrollId
ShardResult
SearchHits a
pitId :: forall a. SearchResult a -> Maybe Text
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
pitId :: Maybe Text
suggest :: Maybe NamedSuggestionResponse
scrollId :: Maybe ScrollId
aggregations :: Maybe AggregationResults
searchHits :: SearchHits a
shards :: ShardResult
timedOut :: Bool
took :: Int
..} -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. SearchHits a -> [Hit a]
hits SearchHits a
searchHits, Maybe ScrollId
scrollId)
Left EsError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. Maybe a
Nothing)
advanceScroll ::
( FromJSON a,
MonadBH m,
MonadThrow m
) =>
ScrollId ->
NominalDiffTime ->
m (ParsedEsResponse (SearchResult a))
advanceScroll :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
ScrollId
-> NominalDiffTime -> m (ParsedEsResponse (SearchResult a))
advanceScroll (ScrollId Text
sid) NominalDiffTime
scroll =
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
"_search", Text
"scroll"] (forall a. ToJSON a => a -> ByteString
encode Value
scrollObject)
where
scrollTime :: Text
scrollTime = forall a. Show a => a -> Text
showText Integer
secs forall a. Semigroup a => a -> a -> a
<> Text
"s"
secs :: Integer
secs :: Integer
secs = forall a b. (RealFrac a, Integral b) => a -> b
round NominalDiffTime
scroll
scrollObject :: Value
scrollObject =
[Pair] -> Value
object
[ Key
"scroll" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
scrollTime,
Key
"scroll_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
sid
]
scanAccumulator ::
(FromJSON a, MonadBH m, MonadThrow m) =>
[Hit a] ->
([Hit a], Maybe ScrollId) ->
m ([Hit a], Maybe ScrollId)
scanAccumulator :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
[Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
scanAccumulator [Hit a]
oldHits ([Hit a]
newHits, Maybe ScrollId
Nothing) = forall (m :: * -> *) a. Monad m => a -> m a
return ([Hit a]
oldHits forall a. [a] -> [a] -> [a]
++ [Hit a]
newHits, forall a. Maybe a
Nothing)
scanAccumulator [Hit a]
oldHits ([], Maybe ScrollId
_) = forall (m :: * -> *) a. Monad m => a -> m a
return ([Hit a]
oldHits, forall a. Maybe a
Nothing)
scanAccumulator [Hit a]
oldHits ([Hit a]
newHits, Maybe ScrollId
msid) = do
([Hit a]
newHits', Maybe ScrollId
msid') <- forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
scroll' Maybe ScrollId
msid
forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
[Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
scanAccumulator ([Hit a]
oldHits 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 :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
IndexName -> Search -> m [Hit a]
scanSearch IndexName
indexName Search
search = do
ParsedEsResponse (SearchResult a)
initialSearchResult <- forall a (m :: * -> *).
(FromJSON a, MonadThrow m, MonadBH m) =>
IndexName -> Search -> m (ParsedEsResponse (SearchResult a))
getInitialScroll IndexName
indexName Search
search
let ([Hit a]
hits', Maybe ScrollId
josh) = case ParsedEsResponse (SearchResult a)
initialSearchResult of
Right SearchResult {Bool
Int
Maybe Text
Maybe AggregationResults
Maybe NamedSuggestionResponse
Maybe ScrollId
ShardResult
SearchHits a
pitId :: Maybe Text
suggest :: Maybe NamedSuggestionResponse
scrollId :: Maybe ScrollId
aggregations :: Maybe AggregationResults
searchHits :: SearchHits a
shards :: ShardResult
timedOut :: Bool
took :: Int
pitId :: forall a. SearchResult a -> Maybe Text
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
..} -> (forall a. SearchHits a -> [Hit a]
hits SearchHits a
searchHits, Maybe ScrollId
scrollId)
Left EsError
_ -> ([], forall a. Maybe a
Nothing)
([Hit a]
totalHits, Maybe ScrollId
_) <- forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
[Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
scanAccumulator [] ([Hit a]
hits', Maybe ScrollId
josh)
forall (m :: * -> *) a. Monad m => a -> m a
return [Hit a]
totalHits
pitAccumulator ::
(FromJSON a, MonadBH m, MonadThrow m) => Search -> [Hit a] -> m [Hit a]
pitAccumulator :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
Search -> [Hit a] -> m [Hit a]
pitAccumulator Search
search [Hit a]
oldHits = do
BHResponse (SearchResult a)
resp <- forall (m :: * -> *) a.
MonadBH m =>
Search -> m (BHResponse (SearchResult a))
searchAll Search
search
ParsedEsResponse (SearchResult a)
parsed <- forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse BHResponse (SearchResult a)
resp
case ParsedEsResponse (SearchResult a)
parsed of
Left EsError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Right SearchResult a
searchResult -> case forall a. SearchHits a -> [Hit a]
hits (forall a. SearchResult a -> SearchHits a
searchHits SearchResult a
searchResult) of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return [Hit a]
oldHits
[Hit a]
newHits -> case (forall a. Hit a -> Maybe [Value]
hitSort forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [Hit a]
newHits, forall a. SearchResult a -> Maybe Text
pitId SearchResult a
searchResult) of
(Maybe [Value]
Nothing, Maybe Text
Nothing) ->
forall a. HasCallStack => [Char] -> a
error [Char]
"no point in time (PIT) ID or last sort value"
(Just [Value]
_, Maybe Text
Nothing) -> forall a. HasCallStack => [Char] -> a
error [Char]
"no point in time (PIT) ID"
(Maybe [Value]
Nothing, Maybe Text
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Hit a]
oldHits forall a. Semigroup a => a -> a -> a
<> [Hit a]
newHits)
(Just [Value]
lastSort, Just Text
pitId') -> do
let newSearch :: Search
newSearch =
Search
search
{ pointInTime :: Maybe PointInTime
pointInTime = forall a. a -> Maybe a
Just (Text -> Text -> PointInTime
PointInTime Text
pitId' Text
"1m"),
searchAfterKey :: Maybe [Value]
searchAfterKey = forall a. a -> Maybe a
Just [Value]
lastSort
}
forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
Search -> [Hit a] -> m [Hit a]
pitAccumulator Search
newSearch ([Hit a]
oldHits forall a. Semigroup a => a -> a -> a
<> [Hit a]
newHits)
pitSearch ::
(FromJSON a, MonadBH m, MonadThrow m, Show a) => IndexName -> Search -> m [Hit a]
pitSearch :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m, Show a) =>
IndexName -> Search -> m [Hit a]
pitSearch IndexName
indexName Search
search = do
ParsedEsResponse OpenPointInTimeResponse
openResp <- forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
IndexName -> m (ParsedEsResponse OpenPointInTimeResponse)
openPointInTime IndexName
indexName
case ParsedEsResponse OpenPointInTimeResponse
openResp of
Left EsError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Right OpenPointInTimeResponse {Text
oPitId :: OpenPointInTimeResponse -> Text
oPitId :: Text
..} -> do
let searchPIT :: Search
searchPIT = Search
search {pointInTime :: Maybe PointInTime
pointInTime = forall a. a -> Maybe a
Just (Text -> Text -> PointInTime
PointInTime Text
oPitId Text
"1m")}
[Hit a]
hits <- forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
Search -> [Hit a] -> m [Hit a]
pitAccumulator Search
searchPIT []
ParsedEsResponse ClosePointInTimeResponse
closeResp <- forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
ClosePointInTime -> m (ParsedEsResponse ClosePointInTimeResponse)
closePointInTime (Text -> ClosePointInTime
ClosePointInTime Text
oPitId)
case ParsedEsResponse ClosePointInTimeResponse
closeResp of
Left EsError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Right (ClosePointInTimeResponse Bool
False Int
_) ->
forall a. HasCallStack => [Char] -> a
error [Char]
"failed to close point in time (PIT)"
Right (ClosePointInTimeResponse Bool
True Int
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return [Hit a]
hits
mkSearch :: Maybe Query -> Maybe Filter -> Search
mkSearch :: Maybe Query -> Maybe Filter -> Search
mkSearch Maybe Query
query Maybe Filter
filter =
Search
{ queryBody :: Maybe Query
queryBody = Maybe Query
query,
filterBody :: Maybe Filter
filterBody = Maybe Filter
filter,
sortBody :: Maybe Sort
sortBody = forall a. Maybe a
Nothing,
aggBody :: Maybe Aggregations
aggBody = forall a. Maybe a
Nothing,
highlight :: Maybe Highlights
highlight = forall a. Maybe a
Nothing,
trackSortScores :: Bool
trackSortScores = Bool
False,
from :: From
from = Int -> From
From Int
0,
size :: Size
size = Int -> Size
Size Int
10,
searchType :: SearchType
searchType = SearchType
SearchTypeQueryThenFetch,
searchAfterKey :: Maybe [Value]
searchAfterKey = forall a. Maybe a
Nothing,
fields :: Maybe [FieldName]
fields = forall a. Maybe a
Nothing,
scriptFields :: Maybe ScriptFields
scriptFields = forall a. Maybe a
Nothing,
source :: Maybe Source
source = forall a. Maybe a
Nothing,
suggestBody :: Maybe Suggest
suggestBody = forall a. Maybe a
Nothing,
pointInTime :: Maybe PointInTime
pointInTime = forall a. Maybe a
Nothing
}
mkAggregateSearch :: Maybe Query -> Aggregations -> Search
mkAggregateSearch :: Maybe Query -> Aggregations -> Search
mkAggregateSearch Maybe Query
query Aggregations
mkSearchAggs =
Search
{ queryBody :: Maybe Query
queryBody = Maybe Query
query,
filterBody :: Maybe Filter
filterBody = forall a. Maybe a
Nothing,
sortBody :: Maybe Sort
sortBody = forall a. Maybe a
Nothing,
aggBody :: Maybe Aggregations
aggBody = forall a. a -> Maybe a
Just Aggregations
mkSearchAggs,
highlight :: Maybe Highlights
highlight = forall a. Maybe a
Nothing,
trackSortScores :: Bool
trackSortScores = Bool
False,
from :: From
from = Int -> From
From Int
0,
size :: Size
size = Int -> Size
Size Int
0,
searchType :: SearchType
searchType = SearchType
SearchTypeQueryThenFetch,
searchAfterKey :: Maybe [Value]
searchAfterKey = forall a. Maybe a
Nothing,
fields :: Maybe [FieldName]
fields = forall a. Maybe a
Nothing,
scriptFields :: Maybe ScriptFields
scriptFields = forall a. Maybe a
Nothing,
source :: Maybe Source
source = forall a. Maybe a
Nothing,
suggestBody :: Maybe Suggest
suggestBody = forall a. Maybe a
Nothing,
pointInTime :: Maybe PointInTime
pointInTime = forall a. Maybe a
Nothing
}
mkHighlightSearch :: Maybe Query -> Highlights -> Search
mkHighlightSearch :: Maybe Query -> Highlights -> Search
mkHighlightSearch Maybe Query
query Highlights
searchHighlights =
Search
{ queryBody :: Maybe Query
queryBody = Maybe Query
query,
filterBody :: Maybe Filter
filterBody = forall a. Maybe a
Nothing,
sortBody :: Maybe Sort
sortBody = forall a. Maybe a
Nothing,
aggBody :: Maybe Aggregations
aggBody = forall a. Maybe a
Nothing,
highlight :: Maybe Highlights
highlight = forall a. a -> Maybe a
Just Highlights
searchHighlights,
trackSortScores :: Bool
trackSortScores = Bool
False,
from :: From
from = Int -> From
From Int
0,
size :: Size
size = Int -> Size
Size Int
10,
searchType :: SearchType
searchType = SearchType
SearchTypeDfsQueryThenFetch,
searchAfterKey :: Maybe [Value]
searchAfterKey = forall a. Maybe a
Nothing,
fields :: Maybe [FieldName]
fields = forall a. Maybe a
Nothing,
scriptFields :: Maybe ScriptFields
scriptFields = forall a. Maybe a
Nothing,
source :: Maybe Source
source = forall a. Maybe a
Nothing,
suggestBody :: Maybe Suggest
suggestBody = forall a. Maybe a
Nothing,
pointInTime :: Maybe PointInTime
pointInTime = 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 forall a. Maybe a
Nothing 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' :: forall (m :: * -> *). MonadThrow m => Text -> m Request
parseUrl' Text
t = forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest ((Char -> Bool) -> ShowS
URI.escapeURIString Char -> Bool
URI.isAllowedInURI (Text -> [Char]
T.unpack Text
t))
basicAuthHook :: Monad m => EsUsername -> EsPassword -> Request -> m Request
basicAuthHook :: forall (m :: * -> *).
Monad m =>
EsUsername -> EsPassword -> Request -> m Request
basicAuthHook (EsUsername Text
u) (EsPassword Text
p) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
applyBasicAuth ByteString
u' ByteString
p'
where
u' :: ByteString
u' = Text -> ByteString
T.encodeUtf8 Text
u
p' :: ByteString
p' = Text -> ByteString
T.encodeUtf8 Text
p
boolQP :: Bool -> Text
boolQP :: Bool -> Text
boolQP Bool
True = Text
"true"
boolQP Bool
False = Text
"false"
countByIndex :: (MonadBH m, MonadThrow m) => IndexName -> CountQuery -> m (ParsedEsResponse CountResponse)
countByIndex :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
IndexName -> CountQuery -> m (ParsedEsResponse CountResponse)
countByIndex (IndexName Text
indexName) CountQuery
q =
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
indexName, Text
"_count"] (forall a. ToJSON a => a -> ByteString
encode CountQuery
q)
openPointInTime ::
(MonadBH m, MonadThrow m) =>
IndexName ->
m (ParsedEsResponse OpenPointInTimeResponse)
openPointInTime :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
IndexName -> m (ParsedEsResponse OpenPointInTimeResponse)
openPointInTime (IndexName Text
indexName) =
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
indexName, Text
"_pit?keep_alive=1m"] ByteString
emptyBody
closePointInTime ::
(MonadBH m, MonadThrow m) =>
ClosePointInTime ->
m (ParsedEsResponse ClosePointInTimeResponse)
closePointInTime :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
ClosePointInTime -> m (ParsedEsResponse ClosePointInTimeResponse)
closePointInTime ClosePointInTime
q = do
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
deleteWithBody [Text
"_pit"] (forall a. ToJSON a => a -> ByteString
encode ClosePointInTime
q)