{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

-- |
-- Module : Database.Bloodhound.Common.Requests
-- Copyright : (C) 2014, 2018 Chris Allen
-- License : BSD-style (see the file LICENSE)
-- Maintainer : Chris Allen <cma@bitemyapp.com>
-- Stability : provisional
-- Portability : GHC
--
-- Request to be run against Elasticsearch servers..
module Database.Bloodhound.Common.Requests
  ( -- * Bloodhound client functions

    -- ** Indices
    createIndex,
    createIndexWith,
    flushIndex,
    deleteIndex,
    updateIndexSettings,
    getIndexSettings,
    forceMergeIndex,
    indexExists,
    openIndex,
    closeIndex,
    listIndices,
    catIndices,
    waitForYellowIndex,
    HealthStatus (..),

    -- *** Index Aliases
    updateIndexAliases,
    getIndexAliases,
    deleteIndexAlias,

    -- *** Index Templates
    putTemplate,
    templateExists,
    deleteTemplate,

    -- ** Mapping
    putMapping,

    -- ** Documents
    indexDocument,
    updateDocument,
    updateByQuery,
    getDocument,
    documentExists,
    deleteDocument,
    deleteByQuery,
    IndexedDocument (..),
    DeletedDocuments (..),
    DeletedDocumentsRetries (..),

    -- ** Searching
    searchAll,
    searchByIndex,
    searchByIndices,
    searchByIndexTemplate,
    searchByIndicesTemplate,
    getInitialScroll,
    getInitialSortedScroll,
    advanceScroll,
    refreshIndex,
    mkSearch,
    mkAggregateSearch,
    mkHighlightSearch,
    mkSearchTemplate,
    bulk,
    pageSearch,
    mkShardCount,
    mkReplicaCount,
    getStatus,
    dispatchSearch,

    -- ** Templates
    storeSearchTemplate,
    getSearchTemplate,
    deleteSearchTemplate,

    -- ** Snapshot/Restore

    -- *** Snapshot Repos
    getSnapshotRepos,
    updateSnapshotRepo,
    verifySnapshotRepo,
    deleteSnapshotRepo,

    -- *** Snapshots
    createSnapshot,
    getSnapshots,
    deleteSnapshot,

    -- *** Restoring Snapshots
    restoreSnapshot,

    -- *** Reindex
    reindex,
    reindexAsync,

    -- *** Task
    getTask,

    -- ** Nodes
    getNodesInfo,
    getNodesStats,

    -- ** Request Utilities
    encodeBulkOperations,
    encodeBulkOperation,

    -- * BHResponse-handling tools
    isVersionConflict,
    isSuccess,
    isCreated,
    parseEsResponse,
    parseEsResponseWith,
    decodeResponse,
    eitherDecodeResponse,

    -- * Count
    countByIndex,

    -- * Generic
    Acknowledged (..),
    Accepted (..),
    IgnoredBody (..),

    -- * Performing Requests
    tryPerformBHRequest,
    performBHRequest,
    withBHResponse,
    withBHResponse_,
    withBHResponseParsedEsResponse,
    keepBHResponse,
    joinBHResponse,
  )
where

import Control.Applicative as A
import Control.Monad
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)
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock
import qualified Data.Vector as V
import Database.Bloodhound.Client.Cluster
import Database.Bloodhound.Common.Types
import Database.Bloodhound.Internal.Utils.Imports (showText)
import Database.Bloodhound.Internal.Utils.Requests
import Prelude hiding (filter, head)

-- | 'mkShardCount' is a straight-forward smart constructor for 'ShardCount'
--  which rejects 'Int' values below 1 and above 1000.
--
-- >>> mkShardCount 10
-- Just (ShardCount 10)
mkShardCount :: Int -> Maybe ShardCount
mkShardCount :: Int -> Maybe ShardCount
mkShardCount Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = Maybe ShardCount
forall a. Maybe a
Nothing
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1000 = Maybe ShardCount
forall a. Maybe a
Nothing
  | Bool
otherwise = ShardCount -> Maybe ShardCount
forall a. a -> Maybe a
Just (Int -> ShardCount
ShardCount Int
n)

-- | 'mkReplicaCount' is a straight-forward smart constructor for 'ReplicaCount'
--  which rejects 'Int' values below 0 and above 1000.
--
-- >>> mkReplicaCount 10
-- Just (ReplicaCount 10)
mkReplicaCount :: Int -> Maybe ReplicaCount
mkReplicaCount :: Int -> Maybe ReplicaCount
mkReplicaCount Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe ReplicaCount
forall a. Maybe a
Nothing
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1000 = Maybe ReplicaCount
forall a. Maybe a
Nothing -- ...
  | Bool
otherwise = ReplicaCount -> Maybe ReplicaCount
forall a. a -> Maybe a
Just (Int -> ReplicaCount
ReplicaCount Int
n)

-- | 'getStatus' fetches the 'Status' of a 'Server'
--
-- >>> serverStatus <- runBH' getStatus
-- >>> fmap tagline (serverStatus)
-- Just "You Know, for Search"
getStatus :: BHRequest StatusDependant Status
getStatus :: BHRequest StatusDependant Status
getStatus = Endpoint -> BHRequest StatusDependant Status
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
get []

-- | 'getSnapshotRepos' gets the definitions of a subset of the
-- defined snapshot repos.
getSnapshotRepos :: SnapshotRepoSelection -> BHRequest StatusDependant [GenericSnapshotRepo]
getSnapshotRepos :: SnapshotRepoSelection
-> BHRequest StatusDependant [GenericSnapshotRepo]
getSnapshotRepos SnapshotRepoSelection
sel =
  GSRs -> [GenericSnapshotRepo]
unGSRs (GSRs -> [GenericSnapshotRepo])
-> BHRequest StatusDependant GSRs
-> BHRequest StatusDependant [GenericSnapshotRepo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endpoint -> BHRequest StatusDependant GSRs
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
get [Text
Item Endpoint
"_snapshot", Text
Item Endpoint
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 (SnapshotRepoPattern -> Text) -> [SnapshotRepoPattern] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SnapshotRepoPattern
p SnapshotRepoPattern
-> [SnapshotRepoPattern] -> [SnapshotRepoPattern]
forall a. a -> [a] -> [a]
: [SnapshotRepoPattern]
ps))
    renderPat :: SnapshotRepoPattern -> Text
renderPat (RepoPattern Text
t) = Text
t
    renderPat (ExactRepo (SnapshotRepoName Text
t)) = Text
t

-- | Wrapper to extract the list of 'GenericSnapshotRepo' in the
-- format they're returned in
newtype GSRs = GSRs {GSRs -> [GenericSnapshotRepo]
unGSRs :: [GenericSnapshotRepo]}

instance FromJSON GSRs where
  parseJSON :: Value -> Parser GSRs
parseJSON = String -> (Object -> Parser GSRs) -> Value -> Parser GSRs
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Collection of GenericSnapshotRepo" Object -> Parser GSRs
parse
    where
      parse :: Object -> Parser GSRs
parse = ([GenericSnapshotRepo] -> GSRs)
-> Parser [GenericSnapshotRepo] -> Parser GSRs
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [GenericSnapshotRepo] -> GSRs
GSRs (Parser [GenericSnapshotRepo] -> Parser GSRs)
-> (Object -> Parser [GenericSnapshotRepo])
-> Object
-> Parser GSRs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pair -> Parser GenericSnapshotRepo)
-> [Pair] -> Parser [GenericSnapshotRepo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Key -> Value -> Parser GenericSnapshotRepo)
-> Pair -> Parser GenericSnapshotRepo
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Value -> Parser GenericSnapshotRepo
go) ([Pair] -> Parser [GenericSnapshotRepo])
-> (Object -> [Pair]) -> Object -> Parser [GenericSnapshotRepo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
X.toList
      go :: Key -> Value -> Parser GenericSnapshotRepo
go Key
rawName = String
-> (Object -> Parser GenericSnapshotRepo)
-> Value
-> Parser GenericSnapshotRepo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GenericSnapshotRepo" ((Object -> Parser GenericSnapshotRepo)
 -> Value -> Parser GenericSnapshotRepo)
-> (Object -> Parser GenericSnapshotRepo)
-> Value
-> Parser GenericSnapshotRepo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        SnapshotRepoName
-> SnapshotRepoType
-> GenericSnapshotRepoSettings
-> GenericSnapshotRepo
GenericSnapshotRepo (Text -> SnapshotRepoName
SnapshotRepoName (Text -> SnapshotRepoName) -> Text -> SnapshotRepoName
forall a b. (a -> b) -> a -> b
$ Key -> Text
toText Key
rawName)
          (SnapshotRepoType
 -> GenericSnapshotRepoSettings -> GenericSnapshotRepo)
-> Parser SnapshotRepoType
-> Parser (GenericSnapshotRepoSettings -> GenericSnapshotRepo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
            Object -> Key -> Parser SnapshotRepoType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
          Parser (GenericSnapshotRepoSettings -> GenericSnapshotRepo)
-> Parser GenericSnapshotRepoSettings -> Parser GenericSnapshotRepo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
            Object -> Key -> Parser GenericSnapshotRepoSettings
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"settings"

-- | Create or update a snapshot repo
updateSnapshotRepo ::
  (SnapshotRepo repo) =>
  -- | Use 'defaultSnapshotRepoUpdateSettings' if unsure
  SnapshotRepoUpdateSettings ->
  repo ->
  BHRequest StatusIndependant Acknowledged
updateSnapshotRepo :: forall repo.
SnapshotRepo repo =>
SnapshotRepoUpdateSettings
-> repo -> BHRequest StatusIndependant Acknowledged
updateSnapshotRepo SnapshotRepoUpdateSettings {Bool
repoUpdateVerify :: Bool
repoUpdateVerify :: SnapshotRepoUpdateSettings -> Bool
..} repo
repo =
  Endpoint -> ByteString -> BHRequest StatusIndependant Acknowledged
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
put Endpoint
endpoint (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    endpoint :: Endpoint
endpoint = [Text
Item Endpoint
"_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", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"false")]
    body :: Value
body =
      [Pair] -> Value
object
        [ Key
"type" Key -> SnapshotRepoType -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SnapshotRepoType
gSnapshotRepoType,
          Key
"settings" Key -> GenericSnapshotRepoSettings -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GenericSnapshotRepoSettings
gSnapshotRepoSettings
        ]
    GenericSnapshotRepo {GenericSnapshotRepoSettings
SnapshotRepoType
SnapshotRepoName
gSnapshotRepoName :: SnapshotRepoName
gSnapshotRepoType :: SnapshotRepoType
gSnapshotRepoSettings :: GenericSnapshotRepoSettings
gSnapshotRepoName :: GenericSnapshotRepo -> SnapshotRepoName
gSnapshotRepoType :: GenericSnapshotRepo -> SnapshotRepoType
gSnapshotRepoSettings :: GenericSnapshotRepo -> GenericSnapshotRepoSettings
..} = repo -> GenericSnapshotRepo
forall r. SnapshotRepo r => r -> GenericSnapshotRepo
toGSnapshotRepo repo
repo

-- | Verify if a snapshot repo is working. __NOTE:__ this API did not
-- make it into Elasticsearch until 1.4. If you use an older version,
-- you will get an error here.
verifySnapshotRepo :: SnapshotRepoName -> BHRequest StatusDependant SnapshotVerification
verifySnapshotRepo :: SnapshotRepoName -> BHRequest StatusDependant SnapshotVerification
verifySnapshotRepo (SnapshotRepoName Text
n) =
  Endpoint
-> ByteString -> BHRequest StatusDependant SnapshotVerification
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post [Text
Item Endpoint
"_snapshot", Text
Item Endpoint
n, Text
Item Endpoint
"_verify"] ByteString
emptyBody

deleteSnapshotRepo :: SnapshotRepoName -> BHRequest StatusIndependant Acknowledged
deleteSnapshotRepo :: SnapshotRepoName -> BHRequest StatusIndependant Acknowledged
deleteSnapshotRepo (SnapshotRepoName Text
n) =
  Endpoint -> BHRequest StatusIndependant Acknowledged
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
delete [Text
Item Endpoint
"_snapshot", Text
Item Endpoint
n]

-- | Create and start a snapshot
createSnapshot ::
  SnapshotRepoName ->
  SnapshotName ->
  SnapshotCreateSettings ->
  BHRequest StatusIndependant Acknowledged
createSnapshot :: SnapshotRepoName
-> SnapshotName
-> SnapshotCreateSettings
-> BHRequest StatusIndependant Acknowledged
createSnapshot (SnapshotRepoName Text
repoName) (SnapshotName Text
snapName) SnapshotCreateSettings {Bool
Maybe IndexSelection
snapWaitForCompletion :: Bool
snapIndices :: Maybe IndexSelection
snapIgnoreUnavailable :: Bool
snapIncludeGlobalState :: Bool
snapPartial :: Bool
snapWaitForCompletion :: SnapshotCreateSettings -> Bool
snapIndices :: SnapshotCreateSettings -> Maybe IndexSelection
snapIgnoreUnavailable :: SnapshotCreateSettings -> Bool
snapIncludeGlobalState :: SnapshotCreateSettings -> Bool
snapPartial :: SnapshotCreateSettings -> Bool
..} =
  Endpoint -> ByteString -> BHRequest StatusIndependant Acknowledged
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
put Endpoint
endpoint ByteString
body
  where
    endpoint :: Endpoint
endpoint = [Text
Item Endpoint
"_snapshot", Text
Item Endpoint
repoName, Text
Item Endpoint
snapName] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
    params :: [(Text, Maybe Text)]
params = [(Text
"wait_for_completion", Text -> Maybe Text
forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
snapWaitForCompletion))]
    body :: ByteString
body = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Pair]
prs
    prs :: [Pair]
prs =
      [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
        [ (Key
"indices" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Text -> Pair)
-> (IndexSelection -> Text) -> IndexSelection -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexSelection -> Text
indexSelectionName (IndexSelection -> Pair) -> Maybe IndexSelection -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe IndexSelection
snapIndices,
          Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"ignore_unavailable" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
snapIgnoreUnavailable),
          Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"ignore_global_state" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
snapIncludeGlobalState),
          Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"partial" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e 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
unIndexName (IndexName -> Text) -> [IndexName] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IndexName
i IndexName -> [IndexName] -> [IndexName]
forall a. a -> [a] -> [a]
: [IndexName]
is))

-- | Get info about known snapshots given a pattern and repo name.
getSnapshots :: SnapshotRepoName -> SnapshotSelection -> BHRequest StatusDependant [SnapshotInfo]
getSnapshots :: SnapshotRepoName
-> SnapshotSelection -> BHRequest StatusDependant [SnapshotInfo]
getSnapshots (SnapshotRepoName Text
repoName) SnapshotSelection
sel =
  SIs -> [SnapshotInfo]
unSIs (SIs -> [SnapshotInfo])
-> BHRequest StatusDependant SIs
-> BHRequest StatusDependant [SnapshotInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endpoint -> BHRequest StatusDependant SIs
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
get [Text
Item Endpoint
"_snapshot", Text
Item Endpoint
repoName, Text
Item Endpoint
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 (SnapshotPattern -> Text) -> [SnapshotPattern] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SnapshotPattern
s SnapshotPattern -> [SnapshotPattern] -> [SnapshotPattern]
forall a. a -> [a] -> [a]
: [SnapshotPattern]
ss))
    renderPath :: SnapshotPattern -> Text
renderPath (SnapPattern Text
t) = Text
t
    renderPath (ExactSnap (SnapshotName Text
t)) = Text
t

newtype SIs = SIs {SIs -> [SnapshotInfo]
unSIs :: [SnapshotInfo]}

instance FromJSON SIs where
  parseJSON :: Value -> Parser SIs
parseJSON = String -> (Object -> Parser SIs) -> Value -> Parser SIs
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Collection of SnapshotInfo" Object -> Parser SIs
parse
    where
      parse :: Object -> Parser SIs
parse Object
o = [SnapshotInfo] -> SIs
SIs ([SnapshotInfo] -> SIs) -> Parser [SnapshotInfo] -> Parser SIs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [SnapshotInfo]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"snapshots"

-- | Delete a snapshot. Cancels if it is running.
deleteSnapshot :: SnapshotRepoName -> SnapshotName -> BHRequest StatusIndependant Acknowledged
deleteSnapshot :: SnapshotRepoName
-> SnapshotName -> BHRequest StatusIndependant Acknowledged
deleteSnapshot (SnapshotRepoName Text
repoName) (SnapshotName Text
snapName) =
  Endpoint -> BHRequest StatusIndependant Acknowledged
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
delete [Text
Item Endpoint
"_snapshot", Text
Item Endpoint
repoName, Text
Item Endpoint
snapName]

-- | Restore a snapshot to the cluster See
-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/modules-snapshots.html#_restore>
-- for more details.
restoreSnapshot ::
  SnapshotRepoName ->
  SnapshotName ->
  -- | Start with 'defaultSnapshotRestoreSettings' and customize
  -- from there for reasonable defaults.
  SnapshotRestoreSettings ->
  BHRequest StatusIndependant Accepted
restoreSnapshot :: SnapshotRepoName
-> SnapshotName
-> SnapshotRestoreSettings
-> BHRequest StatusIndependant Accepted
restoreSnapshot (SnapshotRepoName Text
repoName) (SnapshotName Text
snapName) SnapshotRestoreSettings {Bool
Maybe (NonEmpty Text)
Maybe (NonEmpty RestoreRenameToken)
Maybe IndexSelection
Maybe RestoreIndexSettings
Maybe RestoreRenamePattern
snapRestoreWaitForCompletion :: Bool
snapRestoreIndices :: Maybe IndexSelection
snapRestoreIgnoreUnavailable :: Bool
snapRestoreIncludeGlobalState :: Bool
snapRestoreRenamePattern :: Maybe RestoreRenamePattern
snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
snapRestorePartial :: Bool
snapRestoreIncludeAliases :: Bool
snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
snapRestoreWaitForCompletion :: SnapshotRestoreSettings -> Bool
snapRestoreIndices :: SnapshotRestoreSettings -> Maybe IndexSelection
snapRestoreIgnoreUnavailable :: SnapshotRestoreSettings -> Bool
snapRestoreIncludeGlobalState :: SnapshotRestoreSettings -> Bool
snapRestoreRenamePattern :: SnapshotRestoreSettings -> Maybe RestoreRenamePattern
snapRestoreRenameReplacement :: SnapshotRestoreSettings -> Maybe (NonEmpty RestoreRenameToken)
snapRestorePartial :: SnapshotRestoreSettings -> Bool
snapRestoreIncludeAliases :: SnapshotRestoreSettings -> Bool
snapRestoreIndexSettingsOverrides :: SnapshotRestoreSettings -> Maybe RestoreIndexSettings
snapRestoreIgnoreIndexSettings :: SnapshotRestoreSettings -> Maybe (NonEmpty Text)
..} =
  Endpoint -> ByteString -> BHRequest StatusIndependant Accepted
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post Endpoint
endpoint (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    endpoint :: Endpoint
endpoint = [Text
Item Endpoint
"_snapshot", Text
Item Endpoint
repoName, Text
Item Endpoint
snapName, Text
Item Endpoint
"_restore"] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
    params :: [(Text, Maybe Text)]
params = [(Text
"wait_for_completion", Text -> Maybe Text
forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
snapRestoreWaitForCompletion))]
    body :: Value
body =
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
          [ (Key
"indices" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Text -> Pair)
-> (IndexSelection -> Text) -> IndexSelection -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexSelection -> Text
indexSelectionName (IndexSelection -> Pair) -> Maybe IndexSelection -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe IndexSelection
snapRestoreIndices,
            Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"ignore_unavailable" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
snapRestoreIgnoreUnavailable),
            Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"include_global_state" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
snapRestoreIncludeGlobalState),
            (Key
"rename_pattern" Key -> RestoreRenamePattern -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (RestoreRenamePattern -> Pair)
-> Maybe RestoreRenamePattern -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RestoreRenamePattern
snapRestoreRenamePattern,
            (Key
"rename_replacement" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Text -> Pair)
-> (NonEmpty RestoreRenameToken -> Text)
-> NonEmpty RestoreRenameToken
-> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty RestoreRenameToken -> Text
renderTokens (NonEmpty RestoreRenameToken -> Pair)
-> Maybe (NonEmpty RestoreRenameToken) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty RestoreRenameToken)
snapRestoreRenameReplacement,
            Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"include_aliases" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
snapRestoreIncludeAliases),
            (Key
"index_settings" Key -> RestoreIndexSettings -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (RestoreIndexSettings -> Pair)
-> Maybe RestoreIndexSettings -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RestoreIndexSettings
snapRestoreIndexSettingsOverrides,
            (Key
"ignore_index_settings" Key -> NonEmpty Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (NonEmpty Text -> Pair) -> Maybe (NonEmpty Text) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty Text)
snapRestoreIgnoreIndexSettings
          ]
    renderTokens :: NonEmpty RestoreRenameToken -> Text
renderTokens (RestoreRenameToken
t :| [RestoreRenameToken]
ts) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (RestoreRenameToken -> Text
renderToken (RestoreRenameToken -> Text) -> [RestoreRenameToken] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RestoreRenameToken
t RestoreRenameToken -> [RestoreRenameToken] -> [RestoreRenameToken]
forall a. a -> [a] -> [a]
: [RestoreRenameToken]
ts))
    renderToken :: RestoreRenameToken -> Text
renderToken (RRTLit Text
t) = Text
t
    renderToken RestoreRenameToken
RRSubWholeMatch = Text
"$0"
    renderToken (RRSubGroup RRGroupRefNum
g) = String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (RRGroupRefNum -> Int
rrGroupRefNum RRGroupRefNum
g))

getNodesInfo :: NodeSelection -> BHRequest StatusDependant NodesInfo
getNodesInfo :: NodeSelection -> BHRequest StatusDependant NodesInfo
getNodesInfo NodeSelection
sel =
  Endpoint -> BHRequest StatusDependant NodesInfo
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
get [Text
Item Endpoint
"_nodes", Text
Item Endpoint
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 (NodeSelector -> Text) -> [NodeSelector] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NodeSelector
l NodeSelector -> [NodeSelector] -> [NodeSelector]
forall a. a -> [a] -> [a]
: [NodeSelector]
ls))
      NodeSelection
AllNodes -> Text
"_all"
    selToSeg :: NodeSelector -> Text
selToSeg (NodeByName (NodeName Text
n)) = Text
n
    selToSeg (NodeByFullNodeId (FullNodeId Text
i)) = Text
i
    selToSeg (NodeByHost (Server Text
s)) = Text
s
    selToSeg (NodeByAttribute (NodeAttrName Text
a) Text
v) = Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v

getNodesStats :: NodeSelection -> BHRequest StatusDependant NodesStats
getNodesStats :: NodeSelection -> BHRequest StatusDependant NodesStats
getNodesStats NodeSelection
sel =
  Endpoint -> BHRequest StatusDependant NodesStats
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
get [Text
Item Endpoint
"_nodes", Text
Item Endpoint
selectionSeg, Text
Item Endpoint
"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 (NodeSelector -> Text) -> [NodeSelector] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NodeSelector
l NodeSelector -> [NodeSelector] -> [NodeSelector]
forall a. a -> [a] -> [a]
: [NodeSelector]
ls))
      NodeSelection
AllNodes -> Text
"_all"
    selToSeg :: NodeSelector -> Text
selToSeg (NodeByName (NodeName Text
n)) = Text
n
    selToSeg (NodeByFullNodeId (FullNodeId Text
i)) = Text
i
    selToSeg (NodeByHost (Server Text
s)) = Text
s
    selToSeg (NodeByAttribute (NodeAttrName Text
a) Text
v) = Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v

-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.
--
-- >>> response <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
-- >>> isSuccess response
-- True
-- >>> runBH' $ indexExists (IndexName "didimakeanindex")
-- True
createIndex :: IndexSettings -> IndexName -> BHRequest StatusDependant Acknowledged
createIndex :: IndexSettings
-> IndexName -> BHRequest StatusDependant Acknowledged
createIndex IndexSettings
indexSettings IndexName
indexName =
  Endpoint -> ByteString -> BHRequest StatusDependant Acknowledged
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
put [IndexName -> Text
unIndexName IndexName
indexName] (ByteString -> BHRequest StatusDependant Acknowledged)
-> ByteString -> BHRequest StatusDependant Acknowledged
forall a b. (a -> b) -> a -> b
$ IndexSettings -> ByteString
forall a. ToJSON a => a -> ByteString
encode IndexSettings
indexSettings

-- | Create an index, providing it with any number of settings. This
--  is more expressive than 'createIndex' but makes is more verbose
--  for the common case of configuring only the shard count and
--  replica count.
createIndexWith ::
  [UpdatableIndexSetting] ->
  -- | shard count
  Int ->
  IndexName ->
  BHRequest StatusIndependant Acknowledged
createIndexWith :: [UpdatableIndexSetting]
-> Int -> IndexName -> BHRequest StatusIndependant Acknowledged
createIndexWith [UpdatableIndexSetting]
updates Int
shards IndexName
indexName =
  Endpoint -> ByteString -> BHRequest StatusIndependant Acknowledged
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
put [IndexName -> Text
unIndexName IndexName
indexName] ByteString
body
  where
    body :: ByteString
body =
      Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$
        [Pair] -> Value
object
          [ Key
"settings"
              Key -> Object -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Object] -> Object
deepMerge
                ( Key -> Value -> Object
forall v. Key -> v -> KeyMap v
X.singleton Key
"index.number_of_shards" (Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
shards)
                    Object -> [Object] -> [Object]
forall a. a -> [a] -> [a]
: [Object
u | Object Object
u <- UpdatableIndexSetting -> Value
forall a. ToJSON a => a -> Value
toJSON (UpdatableIndexSetting -> Value)
-> [UpdatableIndexSetting] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UpdatableIndexSetting]
updates]
                )
          ]

-- | 'flushIndex' will flush an index given a 'Server' and an 'IndexName'.
flushIndex :: IndexName -> BHRequest StatusDependant ShardResult
flushIndex :: IndexName -> BHRequest StatusDependant ShardResult
flushIndex IndexName
indexName =
  Endpoint -> ByteString -> BHRequest StatusDependant ShardResult
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_flush"] ByteString
emptyBody

-- | 'deleteIndex' will delete an index given a 'Server' and an 'IndexName'.
--
-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
-- >>> isSuccess response
-- True
-- >>> runBH' $ indexExists (IndexName "didimakeanindex")
-- False
deleteIndex :: IndexName -> BHRequest StatusDependant Acknowledged
deleteIndex :: IndexName -> BHRequest StatusDependant Acknowledged
deleteIndex IndexName
indexName =
  Endpoint -> BHRequest StatusDependant Acknowledged
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
delete [IndexName -> Text
unIndexName IndexName
indexName]

-- | 'updateIndexSettings' will apply a non-empty list of setting updates to an index
--
-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "unconfiguredindex")
-- >>> response <- runBH' $ updateIndexSettings (BlocksWrite False :| []) (IndexName "unconfiguredindex")
-- >>> isSuccess response
-- True
updateIndexSettings ::
  NonEmpty UpdatableIndexSetting ->
  IndexName ->
  BHRequest StatusIndependant Acknowledged
updateIndexSettings :: NonEmpty UpdatableIndexSetting
-> IndexName -> BHRequest StatusIndependant Acknowledged
updateIndexSettings NonEmpty UpdatableIndexSetting
updates IndexName
indexName =
  Endpoint -> ByteString -> BHRequest StatusIndependant Acknowledged
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
put [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_settings"] (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    body :: Value
body = Object -> Value
Object ([Object] -> Object
deepMerge [Object
u | Object Object
u <- UpdatableIndexSetting -> Value
forall a. ToJSON a => a -> Value
toJSON (UpdatableIndexSetting -> Value)
-> [UpdatableIndexSetting] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty UpdatableIndexSetting -> [UpdatableIndexSetting]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty UpdatableIndexSetting
updates])

getIndexSettings :: IndexName -> BHRequest StatusDependant IndexSettingsSummary
getIndexSettings :: IndexName -> BHRequest StatusDependant IndexSettingsSummary
getIndexSettings IndexName
indexName =
  Endpoint -> BHRequest StatusDependant IndexSettingsSummary
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
get [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_settings"]

-- | 'forceMergeIndex'
--
-- The force merge API allows to force merging of one or more indices through
-- an API. The merge relates to the number of segments a Lucene index holds
-- within each shard. The force merge operation allows to reduce the number of
-- segments by merging them.
--
-- This call will block until the merge is complete. If the http connection is
-- lost, the request will continue in the background, and any new requests will
-- block until the previous force merge is complete.

-- For more information see
-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-forcemerge.html#indices-forcemerge>.
-- Nothing
-- worthwhile comes back in the response body, so matching on the status
-- should suffice.
--
-- 'forceMergeIndex' with a maxNumSegments of 1 and onlyExpungeDeletes
-- to True is the main way to release disk space back to the OS being
-- held by deleted documents.
--
-- >>> let ixn = IndexName "unoptimizedindex"
-- >>> _ <- runBH' $ deleteIndex ixn >> createIndex defaultIndexSettings ixn
-- >>> response <- runBH' $ forceMergeIndex (IndexList (ixn :| [])) (defaultIndexOptimizationSettings { maxNumSegments = Just 1, onlyExpungeDeletes = True })
-- >>> isSuccess response
-- True
forceMergeIndex :: IndexSelection -> ForceMergeIndexSettings -> BHRequest StatusDependant ShardsResult
forceMergeIndex :: IndexSelection
-> ForceMergeIndexSettings
-> BHRequest StatusDependant ShardsResult
forceMergeIndex IndexSelection
ixs ForceMergeIndexSettings {Bool
Maybe Int
maxNumSegments :: Maybe Int
onlyExpungeDeletes :: Bool
flushAfterOptimize :: Bool
maxNumSegments :: ForceMergeIndexSettings -> Maybe Int
onlyExpungeDeletes :: ForceMergeIndexSettings -> Bool
flushAfterOptimize :: ForceMergeIndexSettings -> Bool
..} =
  Endpoint -> ByteString -> BHRequest StatusDependant ShardsResult
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post Endpoint
endpoint ByteString
emptyBody
  where
    endpoint :: Endpoint
endpoint = [Text
Item Endpoint
indexName, Text
Item Endpoint
"_forcemerge"] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
    params :: [(Text, Maybe Text)]
params =
      [Maybe (Text, Maybe Text)] -> [(Text, Maybe Text)]
forall a. [Maybe a] -> [a]
catMaybes
        [ (Text
"max_num_segments",) (Maybe Text -> (Text, Maybe Text))
-> (Int -> Maybe Text) -> Int -> (Text, Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Int -> Text) -> Int -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall a. Show a => a -> Text
showText (Int -> (Text, Maybe Text))
-> Maybe Int -> Maybe (Text, Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maxNumSegments,
          (Text, Maybe Text) -> Maybe (Text, Maybe Text)
forall a. a -> Maybe a
Just (Text
"only_expunge_deletes", Text -> Maybe Text
forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
onlyExpungeDeletes)),
          (Text, Maybe Text) -> Maybe (Text, Maybe Text)
forall a. a -> Maybe a
Just (Text
"flush", Text -> Maybe Text
forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
flushAfterOptimize))
        ]
    indexName :: Text
indexName = IndexSelection -> Text
indexSelectionName IndexSelection
ixs

deepMerge :: [Object] -> Object
deepMerge :: [Object] -> Object
deepMerge = (Object -> Object -> Object) -> Object -> [Object] -> Object
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
LS.foldl' ((Value -> Value -> Value) -> Object -> Object -> Object
forall v. (v -> v -> v) -> KeyMap v -> KeyMap v -> KeyMap v
X.unionWith Value -> Value -> Value
merge) Object
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
Item [Object]
a, Object
Item [Object]
b])
    merge Value
_ Value
b = Value
b

doesExist :: Endpoint -> BHRequest StatusDependant Bool
doesExist :: Endpoint -> BHRequest StatusDependant Bool
doesExist =
  (BHResponse StatusDependant IgnoredBody -> Bool)
-> BHRequest StatusDependant IgnoredBody
-> BHRequest StatusDependant Bool
forall a parsingContext b.
(BHResponse StatusDependant a -> b)
-> BHRequest parsingContext a -> BHRequest StatusDependant b
withBHResponse_ BHResponse StatusDependant IgnoredBody -> Bool
forall parsingContext a. BHResponse parsingContext a -> Bool
isSuccess (BHRequest StatusDependant IgnoredBody
 -> BHRequest StatusDependant Bool)
-> (Endpoint -> BHRequest StatusDependant IgnoredBody)
-> Endpoint
-> BHRequest StatusDependant Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
head' @StatusDependant @IgnoredBody

-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
--  in IO
--
-- >>> exists <- runBH' $ indexExists testIndex
indexExists :: IndexName -> BHRequest StatusDependant Bool
indexExists :: IndexName -> BHRequest StatusDependant Bool
indexExists IndexName
indexName =
  Endpoint -> BHRequest StatusDependant Bool
doesExist [IndexName -> Text
unIndexName IndexName
indexName]

-- | 'refreshIndex' will force a refresh on an index. You must
-- do this if you want to read what you wrote.
--
-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
-- >>> _ <- runBH' $ refreshIndex testIndex
refreshIndex :: IndexName -> BHRequest StatusDependant ShardResult
refreshIndex :: IndexName -> BHRequest StatusDependant ShardResult
refreshIndex IndexName
indexName =
  Endpoint -> ByteString -> BHRequest StatusDependant ShardResult
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_refresh"] ByteString
emptyBody

-- | Block until the index becomes available for indexing
--  documents. This is useful for integration tests in which
--  indices are rapidly created and deleted.
waitForYellowIndex :: IndexName -> BHRequest StatusIndependant HealthStatus
waitForYellowIndex :: IndexName -> BHRequest StatusIndependant HealthStatus
waitForYellowIndex IndexName
indexName =
  Endpoint -> BHRequest StatusIndependant HealthStatus
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
get Endpoint
endpoint
  where
    endpoint :: Endpoint
endpoint = [Text
Item Endpoint
"_cluster", Text
Item Endpoint
"health", IndexName -> Text
unIndexName IndexName
indexName] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
    params :: [(Text, Maybe Text)]
params = [(Text
"wait_for_status", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"yellow"), (Text
"timeout", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"10s")]

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
(HealthStatus -> HealthStatus -> Bool)
-> (HealthStatus -> HealthStatus -> Bool) -> Eq HealthStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HealthStatus -> HealthStatus -> Bool
== :: HealthStatus -> HealthStatus -> Bool
$c/= :: HealthStatus -> HealthStatus -> Bool
/= :: HealthStatus -> HealthStatus -> Bool
Eq, Int -> HealthStatus -> ShowS
[HealthStatus] -> ShowS
HealthStatus -> String
(Int -> HealthStatus -> ShowS)
-> (HealthStatus -> String)
-> ([HealthStatus] -> ShowS)
-> Show HealthStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HealthStatus -> ShowS
showsPrec :: Int -> HealthStatus -> ShowS
$cshow :: HealthStatus -> String
show :: HealthStatus -> String
$cshowList :: [HealthStatus] -> ShowS
showList :: [HealthStatus] -> ShowS
Show)

instance FromJSON HealthStatus where
  parseJSON :: Value -> Parser HealthStatus
parseJSON =
    String
-> (Object -> Parser HealthStatus) -> Value -> Parser HealthStatus
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"HealthStatus" ((Object -> Parser HealthStatus) -> Value -> Parser HealthStatus)
-> (Object -> Parser HealthStatus) -> Value -> Parser 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
        (Text
 -> Text
 -> Bool
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Float
 -> HealthStatus)
-> Parser Text
-> Parser
     (Text
      -> Bool
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Float
      -> HealthStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v
          Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cluster_name"
        Parser
  (Text
   -> Bool
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Float
   -> HealthStatus)
-> Parser Text
-> Parser
     (Bool
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Float
      -> HealthStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
        Parser
  (Bool
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Float
   -> HealthStatus)
-> Parser Bool
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Float
      -> HealthStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timed_out"
        Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Float
   -> HealthStatus)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Float
      -> HealthStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number_of_nodes"
        Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Float
   -> HealthStatus)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Float
      -> HealthStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number_of_data_nodes"
        Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Float
   -> HealthStatus)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Float
      -> HealthStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active_primary_shards"
        Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Float
   -> HealthStatus)
-> Parser Int
-> Parser
     (Int
      -> Int -> Int -> Int -> Int -> Int -> Int -> Float -> HealthStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active_shards"
        Parser
  (Int
   -> Int -> Int -> Int -> Int -> Int -> Int -> Float -> HealthStatus)
-> Parser Int
-> Parser
     (Int -> Int -> Int -> Int -> Int -> Int -> Float -> HealthStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"relocating_shards"
        Parser
  (Int -> Int -> Int -> Int -> Int -> Int -> Float -> HealthStatus)
-> Parser Int
-> Parser
     (Int -> Int -> Int -> Int -> Int -> Float -> HealthStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"initializing_shards"
        Parser (Int -> Int -> Int -> Int -> Int -> Float -> HealthStatus)
-> Parser Int
-> Parser (Int -> Int -> Int -> Int -> Float -> HealthStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"unassigned_shards"
        Parser (Int -> Int -> Int -> Int -> Float -> HealthStatus)
-> Parser Int
-> Parser (Int -> Int -> Int -> Float -> HealthStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"delayed_unassigned_shards"
        Parser (Int -> Int -> Int -> Float -> HealthStatus)
-> Parser Int -> Parser (Int -> Int -> Float -> HealthStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number_of_pending_tasks"
        Parser (Int -> Int -> Float -> HealthStatus)
-> Parser Int -> Parser (Int -> Float -> HealthStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number_of_in_flight_fetch"
        Parser (Int -> Float -> HealthStatus)
-> Parser Int -> Parser (Float -> HealthStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"task_max_waiting_in_queue_millis"
        Parser (Float -> HealthStatus)
-> Parser Float -> Parser HealthStatus
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Float
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active_shards_percent_as_number"

openOrCloseIndexes :: OpenCloseIndex -> IndexName -> BHRequest StatusIndependant Acknowledged
openOrCloseIndexes :: OpenCloseIndex
-> IndexName -> BHRequest StatusIndependant Acknowledged
openOrCloseIndexes OpenCloseIndex
oci IndexName
indexName =
  Endpoint -> ByteString -> BHRequest StatusIndependant Acknowledged
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
stringifyOCIndex] ByteString
emptyBody
  where
    stringifyOCIndex :: Text
stringifyOCIndex = case OpenCloseIndex
oci of
      OpenCloseIndex
OpenIndex -> Text
"_open"
      OpenCloseIndex
CloseIndex -> Text
"_close"

-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at
--  <http://www.elastic.co/guide/en/elasticsearch/reference/current/indices-open-close.html>
--
-- >>> response <- runBH' $ openIndex testIndex
openIndex :: IndexName -> BHRequest StatusIndependant Acknowledged
openIndex :: IndexName -> BHRequest StatusIndependant Acknowledged
openIndex = OpenCloseIndex
-> IndexName -> BHRequest StatusIndependant Acknowledged
openOrCloseIndexes OpenCloseIndex
OpenIndex

-- | 'closeIndex' closes an index given a 'Server' and an 'IndexName'. Explained in further detail at
--  <http://www.elastic.co/guide/en/elasticsearch/reference/current/indices-open-close.html>
--
-- >>> response <- runBH' $ closeIndex testIndex
closeIndex :: IndexName -> BHRequest StatusIndependant Acknowledged
closeIndex :: IndexName -> BHRequest StatusIndependant Acknowledged
closeIndex = OpenCloseIndex
-> IndexName -> BHRequest StatusIndependant Acknowledged
openOrCloseIndexes OpenCloseIndex
CloseIndex

-- | 'listIndices' returns a list of all index names on a given 'Server'
listIndices :: BHRequest StatusDependant [IndexName]
listIndices :: BHRequest StatusDependant [IndexName]
listIndices =
  (ListedIndexName -> IndexName) -> [ListedIndexName] -> [IndexName]
forall a b. (a -> b) -> [a] -> [b]
map ListedIndexName -> IndexName
unListedIndexName ([ListedIndexName] -> [IndexName])
-> BHRequest StatusDependant [ListedIndexName]
-> BHRequest StatusDependant [IndexName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endpoint -> BHRequest StatusDependant [ListedIndexName]
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
get [Text
Item Endpoint
"_cat/indices?format=json"]

newtype ListedIndexName = ListedIndexName {ListedIndexName -> IndexName
unListedIndexName :: IndexName}
  deriving stock (ListedIndexName -> ListedIndexName -> Bool
(ListedIndexName -> ListedIndexName -> Bool)
-> (ListedIndexName -> ListedIndexName -> Bool)
-> Eq ListedIndexName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListedIndexName -> ListedIndexName -> Bool
== :: ListedIndexName -> ListedIndexName -> Bool
$c/= :: ListedIndexName -> ListedIndexName -> Bool
/= :: ListedIndexName -> ListedIndexName -> Bool
Eq, Int -> ListedIndexName -> ShowS
[ListedIndexName] -> ShowS
ListedIndexName -> String
(Int -> ListedIndexName -> ShowS)
-> (ListedIndexName -> String)
-> ([ListedIndexName] -> ShowS)
-> Show ListedIndexName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListedIndexName -> ShowS
showsPrec :: Int -> ListedIndexName -> ShowS
$cshow :: ListedIndexName -> String
show :: ListedIndexName -> String
$cshowList :: [ListedIndexName] -> ShowS
showList :: [ListedIndexName] -> ShowS
Show)

instance FromJSON ListedIndexName where
  parseJSON :: Value -> Parser ListedIndexName
parseJSON =
    String
-> (Object -> Parser ListedIndexName)
-> Value
-> Parser ListedIndexName
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ListedIndexName" ((Object -> Parser ListedIndexName)
 -> Value -> Parser ListedIndexName)
-> (Object -> Parser ListedIndexName)
-> Value
-> Parser ListedIndexName
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      IndexName -> ListedIndexName
ListedIndexName (IndexName -> ListedIndexName)
-> Parser IndexName -> Parser ListedIndexName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser IndexName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index"

-- | 'catIndices' returns a list of all index names on a given 'Server' as well as their doc counts
catIndices :: BHRequest StatusDependant [(IndexName, Int)]
catIndices :: BHRequest StatusDependant [(IndexName, Int)]
catIndices =
  (ListedIndexNameWithCount -> (IndexName, Int))
-> [ListedIndexNameWithCount] -> [(IndexName, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ListedIndexNameWithCount -> (IndexName, Int)
unListedIndexNameWithCount ([ListedIndexNameWithCount] -> [(IndexName, Int)])
-> BHRequest StatusDependant [ListedIndexNameWithCount]
-> BHRequest StatusDependant [(IndexName, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endpoint -> BHRequest StatusDependant [ListedIndexNameWithCount]
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
get [Text
Item Endpoint
"_cat/indices?format=json"]

newtype ListedIndexNameWithCount = ListedIndexNameWithCount {ListedIndexNameWithCount -> (IndexName, Int)
unListedIndexNameWithCount :: (IndexName, Int)}
  deriving stock (ListedIndexNameWithCount -> ListedIndexNameWithCount -> Bool
(ListedIndexNameWithCount -> ListedIndexNameWithCount -> Bool)
-> (ListedIndexNameWithCount -> ListedIndexNameWithCount -> Bool)
-> Eq ListedIndexNameWithCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListedIndexNameWithCount -> ListedIndexNameWithCount -> Bool
== :: ListedIndexNameWithCount -> ListedIndexNameWithCount -> Bool
$c/= :: ListedIndexNameWithCount -> ListedIndexNameWithCount -> Bool
/= :: ListedIndexNameWithCount -> ListedIndexNameWithCount -> Bool
Eq, Int -> ListedIndexNameWithCount -> ShowS
[ListedIndexNameWithCount] -> ShowS
ListedIndexNameWithCount -> String
(Int -> ListedIndexNameWithCount -> ShowS)
-> (ListedIndexNameWithCount -> String)
-> ([ListedIndexNameWithCount] -> ShowS)
-> Show ListedIndexNameWithCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListedIndexNameWithCount -> ShowS
showsPrec :: Int -> ListedIndexNameWithCount -> ShowS
$cshow :: ListedIndexNameWithCount -> String
show :: ListedIndexNameWithCount -> String
$cshowList :: [ListedIndexNameWithCount] -> ShowS
showList :: [ListedIndexNameWithCount] -> ShowS
Show)

instance FromJSON ListedIndexNameWithCount where
  parseJSON :: Value -> Parser ListedIndexNameWithCount
parseJSON =
    String
-> (Object -> Parser ListedIndexNameWithCount)
-> Value
-> Parser ListedIndexNameWithCount
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ListedIndexNameWithCount" ((Object -> Parser ListedIndexNameWithCount)
 -> Value -> Parser ListedIndexNameWithCount)
-> (Object -> Parser ListedIndexNameWithCount)
-> Value
-> Parser ListedIndexNameWithCount
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      (IndexName, Int)
xs <- (,) (IndexName -> Int -> (IndexName, Int))
-> Parser IndexName -> Parser (Int -> (IndexName, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser IndexName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index" Parser (Int -> (IndexName, Int))
-> Parser Int -> Parser (IndexName, Int)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"docs.count"
      ListedIndexNameWithCount -> Parser ListedIndexNameWithCount
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ListedIndexNameWithCount -> Parser ListedIndexNameWithCount)
-> ListedIndexNameWithCount -> Parser ListedIndexNameWithCount
forall a b. (a -> b) -> a -> b
$ (IndexName, Int) -> ListedIndexNameWithCount
ListedIndexNameWithCount (IndexName, Int)
xs

-- | 'updateIndexAliases' updates the server's index alias
-- table. Operations are atomic. Explained in further detail at
-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-aliases.html>
--
-- >>> let src = IndexName "a-real-index"
-- >>> let aliasName = IndexName "an-alias"
-- >>> let iAlias = IndexAlias src (IndexAliasName aliasName)
-- >>> let aliasCreate = IndexAliasCreate Nothing Nothing
-- >>> _ <- runBH' $ deleteIndex src
-- >>> isSuccess <$> runBH' (createIndex defaultIndexSettings src)
-- True
-- >>> runBH' $ indexExists src
-- True
-- >>> isSuccess <$> runBH' (updateIndexAliases (AddAlias iAlias aliasCreate :| []))
-- True
-- >>> runBH' $ indexExists aliasName
-- True
updateIndexAliases :: NonEmpty IndexAliasAction -> BHRequest StatusIndependant Acknowledged
updateIndexAliases :: NonEmpty IndexAliasAction
-> BHRequest StatusIndependant Acknowledged
updateIndexAliases NonEmpty IndexAliasAction
actions =
  Endpoint -> ByteString -> BHRequest StatusIndependant Acknowledged
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post [Text
Item Endpoint
"_aliases"] (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    body :: Value
body = [Pair] -> Value
object [Key
"actions" Key -> [IndexAliasAction] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonEmpty IndexAliasAction -> [IndexAliasAction]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexAliasAction
actions]

-- | Get all aliases configured on the server.
getIndexAliases :: BHRequest StatusDependant IndexAliasesSummary
getIndexAliases :: BHRequest StatusDependant IndexAliasesSummary
getIndexAliases =
  Endpoint -> BHRequest StatusDependant IndexAliasesSummary
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
get [Text
Item Endpoint
"_aliases"]

-- | Delete a single alias, removing it from all indices it
--  is currently associated with.
deleteIndexAlias :: IndexAliasName -> BHRequest StatusIndependant Acknowledged
deleteIndexAlias :: IndexAliasName -> BHRequest StatusIndependant Acknowledged
deleteIndexAlias (IndexAliasName IndexName
name) =
  Endpoint -> BHRequest StatusIndependant Acknowledged
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
delete [Text
Item Endpoint
"_all", Text
Item Endpoint
"_alias", IndexName -> Text
unIndexName IndexName
name]

-- | 'putTemplate' creates a template given an 'IndexTemplate' and a 'TemplateName'.
--  Explained in further detail at
--  <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html>
--
--  >>> let idxTpl = IndexTemplate [IndexPattern "tweet-*"] (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
--  >>> resp <- runBH' $ putTemplate idxTpl (TemplateName "tweet-tpl")
putTemplate :: IndexTemplate -> TemplateName -> BHRequest StatusIndependant Acknowledged
putTemplate :: IndexTemplate
-> TemplateName -> BHRequest StatusIndependant Acknowledged
putTemplate IndexTemplate
indexTemplate (TemplateName Text
templateName) =
  Endpoint -> ByteString -> BHRequest StatusIndependant Acknowledged
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
put [Text
Item Endpoint
"_template", Text
Item Endpoint
templateName] (IndexTemplate -> ByteString
forall a. ToJSON a => a -> ByteString
encode IndexTemplate
indexTemplate)

-- | 'templateExists' checks to see if a template exists.
--
--  >>> exists <- runBH' $ templateExists (TemplateName "tweet-tpl")
templateExists :: TemplateName -> BHRequest StatusDependant Bool
templateExists :: TemplateName -> BHRequest StatusDependant Bool
templateExists (TemplateName Text
templateName) =
  Endpoint -> BHRequest StatusDependant Bool
doesExist [Text
Item Endpoint
"_template", Text
Item Endpoint
templateName]

-- | 'deleteTemplate' is an HTTP DELETE and deletes a template.
--
--  >>> let idxTpl = IndexTemplate [IndexPattern "tweet-*"] (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
--  >>> _ <- runBH' $ putTemplate idxTpl (TemplateName "tweet-tpl")
--  >>> resp <- runBH' $ deleteTemplate (TemplateName "tweet-tpl")
deleteTemplate :: TemplateName -> BHRequest StatusIndependant Acknowledged
deleteTemplate :: TemplateName -> BHRequest StatusIndependant Acknowledged
deleteTemplate (TemplateName Text
templateName) =
  Endpoint -> BHRequest StatusIndependant Acknowledged
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
delete [Text
Item Endpoint
"_template", Text
Item Endpoint
templateName]

-- | 'putMapping' is an HTTP PUT and has upsert semantics. Mappings are schemas
-- for documents in indexes.
--
-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
-- >>> resp <- runBH' $ putMapping testIndex TweetMapping
-- >>> print resp
-- Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("content-type","application/json; charset=UTF-8"),("content-encoding","gzip"),("transfer-encoding","chunked")], responseBody = "{\"acknowledged\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
putMapping :: (FromJSON r, ToJSON a) => IndexName -> a -> BHRequest StatusDependant r
putMapping :: forall r a.
(FromJSON r, ToJSON a) =>
IndexName -> a -> BHRequest StatusDependant r
putMapping IndexName
indexName a
mapping =
  -- "_mapping" above is originally transposed
  -- erroneously. The correct API call is: "/INDEX/_mapping"
  Endpoint -> ByteString -> BHRequest StatusDependant r
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
put [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_mapping"] (a -> ByteString
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 = Int -> Text
forall a. Show a => a -> Text
showText (Int -> Text) -> (DocVersion -> Int) -> DocVersion -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocVersion -> Int
docVersionNumber
    versionParams :: DocVersion -> Text -> [(Text, Maybe Text)]
    versionParams :: DocVersion -> Text -> [(Text, Maybe Text)]
versionParams DocVersion
v Text
t =
      [ (Text
"version", Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ DocVersion -> Text
vt DocVersion
v),
        (Text
"version_type", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t)
      ]

-- | 'indexDocument' is the primary way to save a single document in
--  Elasticsearch. The document itself is simply something we can
--  convert into a JSON 'Value'. The 'DocId' will function as the
--  primary key for the document. You are encouraged to generate
--  your own id's and not rely on Elasticsearch's automatic id
--  generation. Read more about it here:
--  https://github.com/bitemyapp/bloodhound/issues/107
--
-- >>> resp <- runBH' $ indexDocument testIndex defaultIndexDocumentSettings exampleTweet (DocId "1")
-- >>> print resp
-- Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("content-type","application/json; charset=UTF-8"),("content-encoding","gzip"),("content-length","152")], responseBody = "{\"_index\":\"twitter\",\"_type\":\"_doc\",\"_id\":\"1\",\"_version\":2,\"result\":\"updated\",\"_shards\":{\"total\":1,\"successful\":1,\"failed\":0},\"_seq_no\":1,\"_primary_term\":1}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
indexDocument ::
  (ToJSON doc) =>
  IndexName ->
  IndexDocumentSettings ->
  doc ->
  DocId ->
  BHRequest StatusDependant IndexedDocument
indexDocument :: forall doc.
ToJSON doc =>
IndexName
-> IndexDocumentSettings
-> doc
-> DocId
-> BHRequest StatusDependant IndexedDocument
indexDocument IndexName
indexName IndexDocumentSettings
cfg doc
document (DocId Text
docId) =
  Endpoint -> ByteString -> BHRequest StatusDependant IndexedDocument
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
put Endpoint
endpoint (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    endpoint :: Endpoint
endpoint = [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_doc", Text
Item Endpoint
docId] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` IndexDocumentSettings -> DocId -> [(Text, Maybe Text)]
indexQueryString IndexDocumentSettings
cfg (Text -> DocId
DocId Text
docId)
    body :: Value
body = IndexDocumentSettings -> doc -> Value
forall doc. ToJSON doc => IndexDocumentSettings -> doc -> Value
encodeDocument IndexDocumentSettings
cfg doc
document

data IndexedDocument = IndexedDocument
  { IndexedDocument -> Text
idxDocIndex :: Text,
    IndexedDocument -> Maybe Text
idxDocType :: Maybe 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
(IndexedDocument -> IndexedDocument -> Bool)
-> (IndexedDocument -> IndexedDocument -> Bool)
-> Eq IndexedDocument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexedDocument -> IndexedDocument -> Bool
== :: IndexedDocument -> IndexedDocument -> Bool
$c/= :: IndexedDocument -> IndexedDocument -> Bool
/= :: IndexedDocument -> IndexedDocument -> Bool
Eq, Int -> IndexedDocument -> ShowS
[IndexedDocument] -> ShowS
IndexedDocument -> String
(Int -> IndexedDocument -> ShowS)
-> (IndexedDocument -> String)
-> ([IndexedDocument] -> ShowS)
-> Show IndexedDocument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexedDocument -> ShowS
showsPrec :: Int -> IndexedDocument -> ShowS
$cshow :: IndexedDocument -> String
show :: IndexedDocument -> String
$cshowList :: [IndexedDocument] -> ShowS
showList :: [IndexedDocument] -> ShowS
Show)

{-# DEPRECATED idxDocType "deprecated since ElasticSearch 6.0" #-}

instance FromJSON IndexedDocument where
  parseJSON :: Value -> Parser IndexedDocument
parseJSON =
    String
-> (Object -> Parser IndexedDocument)
-> Value
-> Parser IndexedDocument
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"IndexedDocument" ((Object -> Parser IndexedDocument)
 -> Value -> Parser IndexedDocument)
-> (Object -> Parser IndexedDocument)
-> Value
-> Parser IndexedDocument
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Text
-> Maybe Text
-> Text
-> Int
-> Text
-> ShardResult
-> Int
-> Int
-> IndexedDocument
IndexedDocument
        (Text
 -> Maybe Text
 -> Text
 -> Int
 -> Text
 -> ShardResult
 -> Int
 -> Int
 -> IndexedDocument)
-> Parser Text
-> Parser
     (Maybe Text
      -> Text
      -> Int
      -> Text
      -> ShardResult
      -> Int
      -> Int
      -> IndexedDocument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v
          Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_index"
        Parser
  (Maybe Text
   -> Text
   -> Int
   -> Text
   -> ShardResult
   -> Int
   -> Int
   -> IndexedDocument)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Int -> Text -> ShardResult -> Int -> Int -> IndexedDocument)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"_type"
        Parser
  (Text
   -> Int -> Text -> ShardResult -> Int -> Int -> IndexedDocument)
-> Parser Text
-> Parser
     (Int -> Text -> ShardResult -> Int -> Int -> IndexedDocument)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_id"
        Parser
  (Int -> Text -> ShardResult -> Int -> Int -> IndexedDocument)
-> Parser Int
-> Parser (Text -> ShardResult -> Int -> Int -> IndexedDocument)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_version"
        Parser (Text -> ShardResult -> Int -> Int -> IndexedDocument)
-> Parser Text
-> Parser (ShardResult -> Int -> Int -> IndexedDocument)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"result"
        Parser (ShardResult -> Int -> Int -> IndexedDocument)
-> Parser ShardResult -> Parser (Int -> Int -> IndexedDocument)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser ShardResult
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_shards"
        Parser (Int -> Int -> IndexedDocument)
-> Parser Int -> Parser (Int -> IndexedDocument)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_seq_no"
        Parser (Int -> IndexedDocument)
-> Parser Int -> Parser IndexedDocument
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_primary_term"

-- | 'updateDocument' provides a way to perform an partial update of a
-- an already indexed document.
updateDocument ::
  (ToJSON patch) =>
  IndexName ->
  IndexDocumentSettings ->
  patch ->
  DocId ->
  BHRequest StatusDependant IndexedDocument
updateDocument :: forall doc.
ToJSON doc =>
IndexName
-> IndexDocumentSettings
-> doc
-> DocId
-> BHRequest StatusDependant IndexedDocument
updateDocument IndexName
indexName IndexDocumentSettings
cfg patch
patch (DocId Text
docId) =
  Endpoint -> ByteString -> BHRequest StatusDependant IndexedDocument
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post Endpoint
endpoint (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    endpoint :: Endpoint
endpoint = [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_update", Text
Item Endpoint
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" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IndexDocumentSettings -> patch -> Value
forall doc. ToJSON doc => IndexDocumentSettings -> doc -> Value
encodeDocument IndexDocumentSettings
cfg patch
patch]

updateByQuery ::
  (FromJSON a) =>
  IndexName ->
  Query ->
  Maybe Script ->
  BHRequest StatusDependant a
updateByQuery :: forall a.
FromJSON a =>
IndexName -> Query -> Maybe Script -> BHRequest StatusDependant a
updateByQuery IndexName
indexName Query
q Maybe Script
mScript =
  Endpoint -> ByteString -> BHRequest StatusDependant a
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post Endpoint
endpoint (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    endpoint :: Endpoint
endpoint = [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_update_by_query"]
    body :: Value
body = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (Key
"query" Key -> Query -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Query
q) Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
scriptObject
    scriptObject :: X.KeyMap Value
    scriptObject :: Object
scriptObject = case Maybe Script -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Script
mScript of
      Value
Null -> Object
forall a. Monoid a => a
mempty
      Object Object
o -> Object
o
      Value
x -> Key
"script" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
x

{-  From ES docs:
      Parent and child documents must be indexed on the same shard.
      This means that the same routing value needs to be provided when getting, deleting, or updating a child document.

    Parent/Child support in Bloodhound requires MUCH more love.
    To work it around for now (and to support the existing unit test) we route "parent" documents to their "_id"
    (which is the default strategy for the ES), and route all child documents to their parens' "_id"

    However, it may not be flexible enough for some corner cases.

    Buld operations are completely unaware of "routing" and are probably broken in that matter.
    Or perhaps they always were, because the old "_parent" would also have this requirement.
-}
indexQueryString :: IndexDocumentSettings -> DocId -> [(Text, Maybe Text)]
indexQueryString :: IndexDocumentSettings -> DocId -> [(Text, Maybe Text)]
indexQueryString IndexDocumentSettings
cfg (DocId Text
docId) =
  IndexDocumentSettings -> [(Text, Maybe Text)]
versionCtlParams IndexDocumentSettings
cfg [(Text, Maybe Text)]
-> [(Text, Maybe Text)] -> [(Text, Maybe Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Maybe Text)]
routeParams
  where
    routeParams :: [(Text, Maybe Text)]
routeParams = case IndexDocumentSettings -> Maybe JoinRelation
idsJoinRelation IndexDocumentSettings
cfg of
      Maybe JoinRelation
Nothing -> []
      Just (ParentDocument FieldName
_ RelationName
_) -> [(Text
"routing", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
docId)]
      Just (ChildDocument FieldName
_ RelationName
_ (DocId Text
pid)) -> [(Text
"routing", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pid)]

encodeDocument :: (ToJSON doc) => IndexDocumentSettings -> doc -> Value
encodeDocument :: forall doc. ToJSON doc => IndexDocumentSettings -> doc -> Value
encodeDocument IndexDocumentSettings
cfg doc
document =
  case IndexDocumentSettings -> Maybe JoinRelation
idsJoinRelation IndexDocumentSettings
cfg of
    Maybe JoinRelation
Nothing -> doc -> Value
forall a. ToJSON a => a -> Value
toJSON doc
document
    Just (ParentDocument (FieldName Text
field) RelationName
name) ->
      Value -> Value -> Value
mergeObjects (doc -> Value
forall a. ToJSON a => a -> Value
toJSON doc
document) ([Pair] -> Value
object [Text -> Key
fromText Text
field Key -> RelationName -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RelationName
name])
    Just (ChildDocument (FieldName Text
field) RelationName
name DocId
parent) ->
      Value -> Value -> Value
mergeObjects (doc -> Value
forall a. ToJSON a => a -> Value
toJSON doc
document) ([Pair] -> Value
object [Text -> Key
fromText Text
field Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"name" Key -> RelationName -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RelationName
name, Key
"parent" Key -> DocId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e 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 Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
b)
    mergeObjects Value
_ Value
_ = String -> Value
forall a. HasCallStack => String -> a
error String
"Impossible happened: both document body and join parameters must be objects"

-- | 'deleteDocument' is the primary way to delete a single document.
--
-- >>> _ <- runBH' $ deleteDocument testIndex (DocId "1")
deleteDocument :: IndexName -> DocId -> BHRequest StatusDependant IndexedDocument
deleteDocument :: IndexName -> DocId -> BHRequest StatusDependant IndexedDocument
deleteDocument IndexName
indexName (DocId Text
docId) =
  Endpoint -> BHRequest StatusDependant IndexedDocument
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
delete [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_doc", Text
Item Endpoint
docId]

-- | 'deleteByQuery' performs a deletion on every document that matches a query.
--
-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
-- >>> _ <- runBH' $ deleteDocument testIndex query
deleteByQuery :: IndexName -> Query -> BHRequest StatusDependant DeletedDocuments
deleteByQuery :: IndexName -> Query -> BHRequest StatusDependant DeletedDocuments
deleteByQuery IndexName
indexName Query
query =
  Endpoint
-> ByteString -> BHRequest StatusDependant DeletedDocuments
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_delete_by_query"] (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    body :: Value
body = [Pair] -> Value
object [Key
"query" Key -> Query -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e 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] -- TODO find examples
  }
  deriving stock (DeletedDocuments -> DeletedDocuments -> Bool
(DeletedDocuments -> DeletedDocuments -> Bool)
-> (DeletedDocuments -> DeletedDocuments -> Bool)
-> Eq DeletedDocuments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeletedDocuments -> DeletedDocuments -> Bool
== :: DeletedDocuments -> DeletedDocuments -> Bool
$c/= :: DeletedDocuments -> DeletedDocuments -> Bool
/= :: DeletedDocuments -> DeletedDocuments -> Bool
Eq, Int -> DeletedDocuments -> ShowS
[DeletedDocuments] -> ShowS
DeletedDocuments -> String
(Int -> DeletedDocuments -> ShowS)
-> (DeletedDocuments -> String)
-> ([DeletedDocuments] -> ShowS)
-> Show DeletedDocuments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeletedDocuments -> ShowS
showsPrec :: Int -> DeletedDocuments -> ShowS
$cshow :: DeletedDocuments -> String
show :: DeletedDocuments -> String
$cshowList :: [DeletedDocuments] -> ShowS
showList :: [DeletedDocuments] -> ShowS
Show)

instance FromJSON DeletedDocuments where
  parseJSON :: Value -> Parser DeletedDocuments
parseJSON =
    String
-> (Object -> Parser DeletedDocuments)
-> Value
-> Parser DeletedDocuments
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DeletedDocuments" ((Object -> Parser DeletedDocuments)
 -> Value -> Parser DeletedDocuments)
-> (Object -> Parser DeletedDocuments)
-> Value
-> Parser DeletedDocuments
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Int
-> Bool
-> Int
-> Int
-> Int
-> Int
-> Int
-> DeletedDocumentsRetries
-> Int
-> Float
-> Int
-> [Value]
-> DeletedDocuments
DeletedDocuments
        (Int
 -> Bool
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> DeletedDocumentsRetries
 -> Int
 -> Float
 -> Int
 -> [Value]
 -> DeletedDocuments)
-> Parser Int
-> Parser
     (Bool
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> DeletedDocumentsRetries
      -> Int
      -> Float
      -> Int
      -> [Value]
      -> DeletedDocuments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"took"
        Parser
  (Bool
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> DeletedDocumentsRetries
   -> Int
   -> Float
   -> Int
   -> [Value]
   -> DeletedDocuments)
-> Parser Bool
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> DeletedDocumentsRetries
      -> Int
      -> Float
      -> Int
      -> [Value]
      -> DeletedDocuments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timed_out"
        Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> DeletedDocumentsRetries
   -> Int
   -> Float
   -> Int
   -> [Value]
   -> DeletedDocuments)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> DeletedDocumentsRetries
      -> Int
      -> Float
      -> Int
      -> [Value]
      -> DeletedDocuments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total"
        Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> DeletedDocumentsRetries
   -> Int
   -> Float
   -> Int
   -> [Value]
   -> DeletedDocuments)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> DeletedDocumentsRetries
      -> Int
      -> Float
      -> Int
      -> [Value]
      -> DeletedDocuments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deleted"
        Parser
  (Int
   -> Int
   -> Int
   -> DeletedDocumentsRetries
   -> Int
   -> Float
   -> Int
   -> [Value]
   -> DeletedDocuments)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> DeletedDocumentsRetries
      -> Int
      -> Float
      -> Int
      -> [Value]
      -> DeletedDocuments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"batches"
        Parser
  (Int
   -> Int
   -> DeletedDocumentsRetries
   -> Int
   -> Float
   -> Int
   -> [Value]
   -> DeletedDocuments)
-> Parser Int
-> Parser
     (Int
      -> DeletedDocumentsRetries
      -> Int
      -> Float
      -> Int
      -> [Value]
      -> DeletedDocuments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version_conflicts"
        Parser
  (Int
   -> DeletedDocumentsRetries
   -> Int
   -> Float
   -> Int
   -> [Value]
   -> DeletedDocuments)
-> Parser Int
-> Parser
     (DeletedDocumentsRetries
      -> Int -> Float -> Int -> [Value] -> DeletedDocuments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"noops"
        Parser
  (DeletedDocumentsRetries
   -> Int -> Float -> Int -> [Value] -> DeletedDocuments)
-> Parser DeletedDocumentsRetries
-> Parser (Int -> Float -> Int -> [Value] -> DeletedDocuments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser DeletedDocumentsRetries
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"retries"
        Parser (Int -> Float -> Int -> [Value] -> DeletedDocuments)
-> Parser Int
-> Parser (Float -> Int -> [Value] -> DeletedDocuments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"throttled_millis"
        Parser (Float -> Int -> [Value] -> DeletedDocuments)
-> Parser Float -> Parser (Int -> [Value] -> DeletedDocuments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Float
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"requests_per_second"
        Parser (Int -> [Value] -> DeletedDocuments)
-> Parser Int -> Parser ([Value] -> DeletedDocuments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"throttled_until_millis"
        Parser ([Value] -> DeletedDocuments)
-> Parser [Value] -> Parser DeletedDocuments
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser [Value]
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
(DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool)
-> (DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool)
-> Eq DeletedDocumentsRetries
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
== :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
$c/= :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
/= :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
Eq, Int -> DeletedDocumentsRetries -> ShowS
[DeletedDocumentsRetries] -> ShowS
DeletedDocumentsRetries -> String
(Int -> DeletedDocumentsRetries -> ShowS)
-> (DeletedDocumentsRetries -> String)
-> ([DeletedDocumentsRetries] -> ShowS)
-> Show DeletedDocumentsRetries
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeletedDocumentsRetries -> ShowS
showsPrec :: Int -> DeletedDocumentsRetries -> ShowS
$cshow :: DeletedDocumentsRetries -> String
show :: DeletedDocumentsRetries -> String
$cshowList :: [DeletedDocumentsRetries] -> ShowS
showList :: [DeletedDocumentsRetries] -> ShowS
Show)

instance FromJSON DeletedDocumentsRetries where
  parseJSON :: Value -> Parser DeletedDocumentsRetries
parseJSON =
    String
-> (Object -> Parser DeletedDocumentsRetries)
-> Value
-> Parser DeletedDocumentsRetries
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DeletedDocumentsRetries" ((Object -> Parser DeletedDocumentsRetries)
 -> Value -> Parser DeletedDocumentsRetries)
-> (Object -> Parser DeletedDocumentsRetries)
-> Value
-> Parser DeletedDocumentsRetries
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Int -> Int -> DeletedDocumentsRetries
DeletedDocumentsRetries
        (Int -> Int -> DeletedDocumentsRetries)
-> Parser Int -> Parser (Int -> DeletedDocumentsRetries)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bulk"
        Parser (Int -> DeletedDocumentsRetries)
-> Parser Int -> Parser DeletedDocumentsRetries
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
          Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"search"

-- | 'bulk' uses
--   <http://www.elastic.co/guide/en/elasticsearch/reference/current/docs-bulk.html Elasticsearch's bulk API>
--   to perform bulk operations. The 'BulkOperation' data type encodes the
--   index\/update\/delete\/create operations. You pass a 'V.Vector' of 'BulkOperation's
--   and a 'Server' to 'bulk' in order to send those operations up to your Elasticsearch
--   server to be performed. I changed from [BulkOperation] to a Vector due to memory overhead.
--
-- >>> let stream = V.fromList [BulkIndex testIndex (DocId "2") (toJSON (BulkTest "blah"))]
-- >>> _ <- runBH' $ bulk stream
-- >>> _ <- runBH' $ refreshIndex testIndex
bulk ::
  (ParseBHResponse contextualized) =>
  V.Vector BulkOperation ->
  BHRequest contextualized BulkResponse
bulk :: forall contextualized.
ParseBHResponse contextualized =>
Vector BulkOperation -> BHRequest contextualized BulkResponse
bulk =
  Endpoint -> ByteString -> BHRequest contextualized BulkResponse
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post [Text
Item Endpoint
"_bulk"] (ByteString -> BHRequest contextualized BulkResponse)
-> (Vector BulkOperation -> ByteString)
-> Vector BulkOperation
-> BHRequest contextualized BulkResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector BulkOperation -> ByteString
encodeBulkOperations

-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
--  into an 'L.ByteString'
--
-- >>> let bulkOps = V.fromList [BulkIndex testIndex (DocId "2") (toJSON (BulkTest "blah"))]
-- >>> encodeBulkOperations bulkOps
-- "\n{\"index\":{\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}\n"
encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
encodeBulkOperations :: Vector BulkOperation -> ByteString
encodeBulkOperations Vector BulkOperation
stream = ByteString
collapsed
  where
    blobs :: Vector ByteString
blobs =
      (BulkOperation -> ByteString)
-> Vector BulkOperation -> Vector ByteString
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BulkOperation -> ByteString
encodeBulkOperation Vector BulkOperation
stream
    mashedTaters :: Builder
mashedTaters =
      Builder -> Vector ByteString -> Builder
mash (Builder
forall a. Monoid a => a
mempty :: Builder) Vector ByteString
blobs
    collapsed :: ByteString
collapsed =
      Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend Builder
mashedTaters (ByteString -> Builder
byteString ByteString
"\n")
    mash :: Builder -> V.Vector L.ByteString -> Builder
    mash :: Builder -> Vector ByteString -> Builder
mash = (Builder -> ByteString -> Builder)
-> Builder -> Vector ByteString -> Builder
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' (\Builder
b ByteString
x -> Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
lazyByteString ByteString
x)

mkBulkStreamValue :: Text -> IndexName -> Text -> Value
mkBulkStreamValue :: Text -> IndexName -> Text -> Value
mkBulkStreamValue Text
operation IndexName
indexName Text
docId =
  [Pair] -> Value
object
    [ Text -> Key
fromText Text
operation
        Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
          [ Key
"_index" Key -> IndexName -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IndexName
indexName,
            Key
"_id" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
docId
          ]
    ]

mkBulkStreamValueAuto :: Text -> IndexName -> Value
mkBulkStreamValueAuto :: Text -> IndexName -> Value
mkBulkStreamValueAuto Text
operation IndexName
indexName =
  [Pair] -> Value
object
    [ Text -> Key
fromText Text
operation
        Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"_index" Key -> IndexName -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IndexName
indexName]
    ]

mkBulkStreamValueWithMeta :: [UpsertActionMetadata] -> Text -> IndexName -> Text -> Value
mkBulkStreamValueWithMeta :: [UpsertActionMetadata] -> Text -> IndexName -> Text -> Value
mkBulkStreamValueWithMeta [UpsertActionMetadata]
meta Text
operation IndexName
indexName Text
docId =
  [Pair] -> Value
object
    [ Text -> Key
fromText Text
operation
        Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
          ( [ Key
"_index" Key -> IndexName -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IndexName
indexName,
              Key
"_id" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
docId
            ]
              [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> (UpsertActionMetadata -> Pair
buildUpsertActionMetadata (UpsertActionMetadata -> Pair) -> [UpsertActionMetadata] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UpsertActionMetadata]
meta)
          )
    ]

-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
--  into an 'L.ByteString'
--
-- >>> let bulkOp = BulkIndex testIndex (DocId "2") (toJSON (BulkTest "blah"))
-- >>> encodeBulkOperation bulkOp
-- "{\"index\":{\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}"
encodeBulkOperation :: BulkOperation -> L.ByteString
encodeBulkOperation :: BulkOperation -> ByteString
encodeBulkOperation (BulkIndex IndexName
indexName (DocId Text
docId) Value
value) = ByteString
blob
  where
    metadata :: Value
metadata = Text -> IndexName -> Text -> Value
mkBulkStreamValue Text
"index" IndexName
indexName Text
docId
    blob :: ByteString
blob = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
metadata ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
value
encodeBulkOperation (BulkIndexAuto IndexName
indexName Value
value) = ByteString
blob
  where
    metadata :: Value
metadata = Text -> IndexName -> Value
mkBulkStreamValueAuto Text
"index" IndexName
indexName
    blob :: ByteString
blob = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
metadata ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
value
encodeBulkOperation (BulkIndexEncodingAuto IndexName
indexName Encoding
encoding) = Builder -> ByteString
toLazyByteString Builder
blob
  where
    metadata :: Encoding
metadata = Value -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> IndexName -> Value
mkBulkStreamValueAuto Text
"index" IndexName
indexName)
    blob :: Builder
blob = Encoding -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding Encoding
metadata Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Encoding -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding Encoding
encoding
encodeBulkOperation (BulkCreate IndexName
indexName (DocId Text
docId) Value
value) = ByteString
blob
  where
    metadata :: Value
metadata = Text -> IndexName -> Text -> Value
mkBulkStreamValue Text
"create" IndexName
indexName Text
docId
    blob :: ByteString
blob = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
metadata ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
value
encodeBulkOperation (BulkDelete IndexName
indexName (DocId Text
docId)) = ByteString
blob
  where
    metadata :: Value
metadata = Text -> IndexName -> Text -> Value
mkBulkStreamValue Text
"delete" IndexName
indexName Text
docId
    blob :: ByteString
blob = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
metadata
encodeBulkOperation (BulkUpdate IndexName
indexName (DocId Text
docId) Value
value) = ByteString
blob
  where
    metadata :: Value
metadata = Text -> IndexName -> Text -> Value
mkBulkStreamValue Text
"update" IndexName
indexName Text
docId
    doc :: Value
doc = [Pair] -> Value
object [Key
"doc" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
value]
    blob :: ByteString
blob = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
metadata ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
doc
encodeBulkOperation
  ( BulkUpsert
      IndexName
indexName
      (DocId Text
docId)
      UpsertPayload
payload
      [UpsertActionMetadata]
actionMeta
    ) = ByteString
blob
    where
      metadata :: Value
metadata = [UpsertActionMetadata] -> Text -> IndexName -> Text -> Value
mkBulkStreamValueWithMeta [UpsertActionMetadata]
actionMeta Text
"update" IndexName
indexName Text
docId
      blob :: ByteString
blob = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
metadata ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
doc
      doc :: Value
doc = case UpsertPayload
payload of
        UpsertDoc Value
value -> [Pair] -> Value
object [Key
"doc" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
value, Key
"doc_as_upsert" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e 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" Key -> Bool -> Item [Pair]
forall v. ToJSON v => Key -> v -> Item [Pair]
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True] else []
              upsert :: [Pair]
upsert = [Key
"upsert" Key -> Value -> Item [Pair]
forall v. ToJSON v => Key -> v -> Item [Pair]
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
value]
           in case ([Pair] -> Value
object ([Pair]
scup [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
upsert), Script -> Value
forall a. ToJSON a => a -> Value
toJSON Script
script) of
                (Object Object
obj, Object Object
jscript) -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Object
jscript Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
obj
                (Value, Value)
_ -> String -> Value
forall a. HasCallStack => String -> a
error String
"Impossible happened: serialising Script to Json should always be Object"
encodeBulkOperation (BulkCreateEncoding IndexName
indexName (DocId Text
docId) Encoding
encoding) =
  Builder -> ByteString
toLazyByteString Builder
blob
  where
    metadata :: Encoding
metadata = Value -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> IndexName -> Text -> Value
mkBulkStreamValue Text
"create" IndexName
indexName Text
docId)
    blob :: Builder
blob = Encoding -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding Encoding
metadata Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Encoding -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding Encoding
encoding

-- | 'getDocument' is a straight-forward way to fetch a single document from
--  Elasticsearch using a 'Server', 'IndexName', and a 'DocId'.
--  The 'DocId' is the primary key for your Elasticsearch document.
--
-- >>> yourDoc <- runBH' $ getDocument testIndex (DocId "1")
getDocument :: (FromJSON a) => IndexName -> DocId -> BHRequest StatusIndependant (EsResult a)
getDocument :: forall a.
FromJSON a =>
IndexName -> DocId -> BHRequest StatusIndependant (EsResult a)
getDocument IndexName
indexName (DocId Text
docId) =
  Endpoint -> BHRequest StatusIndependant (EsResult a)
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
get [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_doc", Text
Item Endpoint
docId]

-- | 'documentExists' enables you to check if a document exists.
documentExists :: IndexName -> DocId -> BHRequest StatusDependant Bool
documentExists :: IndexName -> DocId -> BHRequest StatusDependant Bool
documentExists IndexName
indexName (DocId Text
docId) =
  Endpoint -> BHRequest StatusDependant Bool
doesExist [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_doc", Text
Item Endpoint
docId]

dispatchSearch :: (FromJSON a) => Endpoint -> Search -> BHRequest StatusDependant (SearchResult a)
dispatchSearch :: forall a.
FromJSON a =>
Endpoint -> Search -> BHRequest StatusDependant (SearchResult a)
dispatchSearch Endpoint
endpoint Search
search =
  Endpoint
-> ByteString -> BHRequest StatusDependant (SearchResult a)
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post Endpoint
url' (Search -> ByteString
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 SearchType -> SearchType -> Bool
forall a. Eq a => a -> a -> Bool
== SearchType
SearchTypeDfsQueryThenFetch = [(Text
stText, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"dfs_query_then_fetch")]
          -- used to catch 'SearchTypeQueryThenFetch', which is also the default
          | Bool
otherwise = []

-- | 'searchAll', given a 'Search', will perform that search against all indexes
--  on an Elasticsearch server. Try to avoid doing this if it can be helped.
--
-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
-- >>> let search = mkSearch (Just query) Nothing
-- >>> response <- runBH' $ searchAll search
searchAll :: (FromJSON a) => Search -> BHRequest StatusDependant (SearchResult a)
searchAll :: forall a.
FromJSON a =>
Search -> BHRequest StatusDependant (SearchResult a)
searchAll =
  Endpoint -> Search -> BHRequest StatusDependant (SearchResult a)
forall a.
FromJSON a =>
Endpoint -> Search -> BHRequest StatusDependant (SearchResult a)
dispatchSearch [Text
Item Endpoint
"_search"]

-- | 'searchByIndex', given a 'Search' and an 'IndexName', will perform that search
--  within an index on an Elasticsearch server.
--
-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
-- >>> let search = mkSearch (Just query) Nothing
-- >>> response <- runBH' $ searchByIndex testIndex search
searchByIndex :: (FromJSON a) => IndexName -> Search -> BHRequest StatusDependant (SearchResult a)
searchByIndex :: forall a.
FromJSON a =>
IndexName -> Search -> BHRequest StatusDependant (SearchResult a)
searchByIndex IndexName
indexName =
  Endpoint -> Search -> BHRequest StatusDependant (SearchResult a)
forall a.
FromJSON a =>
Endpoint -> Search -> BHRequest StatusDependant (SearchResult a)
dispatchSearch [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_search"]

-- | 'searchByIndices' is a variant of 'searchByIndex' that executes a
--  'Search' over many indices. This is much faster than using
--  'mapM' to 'searchByIndex' over a collection since it only
--  causes a single HTTP request to be emitted.
searchByIndices :: (FromJSON a) => NonEmpty IndexName -> Search -> BHRequest StatusDependant (SearchResult a)
searchByIndices :: forall a.
FromJSON a =>
NonEmpty IndexName
-> Search -> BHRequest StatusDependant (SearchResult a)
searchByIndices NonEmpty IndexName
ixs =
  Endpoint -> Search -> BHRequest StatusDependant (SearchResult a)
forall a.
FromJSON a =>
Endpoint -> Search -> BHRequest StatusDependant (SearchResult a)
dispatchSearch [Text
Item Endpoint
renderedIxs, Text
Item Endpoint
"_search"]
  where
    renderedIxs :: Text
renderedIxs = Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
',') ((IndexName -> Text) -> [IndexName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map IndexName -> Text
unIndexName (NonEmpty IndexName -> [IndexName]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexName
ixs))

dispatchSearchTemplate ::
  (FromJSON a) =>
  Endpoint ->
  SearchTemplate ->
  BHRequest StatusDependant (SearchResult a)
dispatchSearchTemplate :: forall a.
FromJSON a =>
Endpoint
-> SearchTemplate -> BHRequest StatusDependant (SearchResult a)
dispatchSearchTemplate Endpoint
endpoint SearchTemplate
search =
  Endpoint
-> ByteString -> BHRequest StatusDependant (SearchResult a)
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post Endpoint
endpoint (ByteString -> BHRequest StatusDependant (SearchResult a))
-> ByteString -> BHRequest StatusDependant (SearchResult a)
forall a b. (a -> b) -> a -> b
$ SearchTemplate -> ByteString
forall a. ToJSON a => a -> ByteString
encode SearchTemplate
search

-- | 'searchByIndexTemplate', given a 'SearchTemplate' and an 'IndexName', will perform that search
--  within an index on an Elasticsearch server.
--
-- >>> let query = SearchTemplateSource "{\"query\": { \"match\" : { \"{{my_field}}\" : \"{{my_value}}\" } }, \"size\" : \"{{my_size}}\"}"
-- >>> let search = mkSearchTemplate (Right query) Nothing
-- >>> response <- runBH' $ searchByIndexTemplate testIndex search
searchByIndexTemplate ::
  (FromJSON a) =>
  IndexName ->
  SearchTemplate ->
  BHRequest StatusDependant (SearchResult a)
searchByIndexTemplate :: forall a.
FromJSON a =>
IndexName
-> SearchTemplate -> BHRequest StatusDependant (SearchResult a)
searchByIndexTemplate IndexName
indexName =
  Endpoint
-> SearchTemplate -> BHRequest StatusDependant (SearchResult a)
forall a.
FromJSON a =>
Endpoint
-> SearchTemplate -> BHRequest StatusDependant (SearchResult a)
dispatchSearchTemplate [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_search", Text
Item Endpoint
"template"]

-- | 'searchByIndicesTemplate' is a variant of 'searchByIndexTemplate' that executes a
--  'SearchTemplate' over many indices. This is much faster than using
--  'mapM' to 'searchByIndexTemplate' over a collection since it only
--  causes a single HTTP request to be emitted.
searchByIndicesTemplate ::
  (FromJSON a) =>
  NonEmpty IndexName ->
  SearchTemplate ->
  BHRequest StatusDependant (SearchResult a)
searchByIndicesTemplate :: forall a.
FromJSON a =>
NonEmpty IndexName
-> SearchTemplate -> BHRequest StatusDependant (SearchResult a)
searchByIndicesTemplate NonEmpty IndexName
ixs =
  Endpoint
-> SearchTemplate -> BHRequest StatusDependant (SearchResult a)
forall a.
FromJSON a =>
Endpoint
-> SearchTemplate -> BHRequest StatusDependant (SearchResult a)
dispatchSearchTemplate [Text
Item Endpoint
renderedIxs, Text
Item Endpoint
"_search", Text
Item Endpoint
"template"]
  where
    renderedIxs :: Text
renderedIxs = Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
',') ((IndexName -> Text) -> [IndexName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map IndexName -> Text
unIndexName (NonEmpty IndexName -> [IndexName]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexName
ixs))

-- | 'storeSearchTemplate', saves a 'SearchTemplateSource' to be used later.
storeSearchTemplate :: SearchTemplateId -> SearchTemplateSource -> BHRequest StatusDependant Acknowledged
storeSearchTemplate :: SearchTemplateId
-> SearchTemplateSource -> BHRequest StatusDependant Acknowledged
storeSearchTemplate (SearchTemplateId Text
tid) SearchTemplateSource
ts =
  Endpoint -> ByteString -> BHRequest StatusDependant Acknowledged
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post [Text
Item Endpoint
"_scripts", Text
Item Endpoint
tid] (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    body :: Value
body = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Object
forall v. [(Key, v)] -> KeyMap v
X.fromList [Key
"script" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Object -> Value
Object (Key
"lang" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"mustache" Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Key
"source" Key -> SearchTemplateSource -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SearchTemplateSource
ts)]

-- | 'getSearchTemplate', get info of an stored 'SearchTemplateSource'.
getSearchTemplate :: SearchTemplateId -> BHRequest StatusIndependant GetTemplateScript
getSearchTemplate :: SearchTemplateId -> BHRequest StatusIndependant GetTemplateScript
getSearchTemplate (SearchTemplateId Text
tid) =
  Endpoint -> BHRequest StatusIndependant GetTemplateScript
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
get [Text
Item Endpoint
"_scripts", Text
Item Endpoint
tid]

-- | 'storeSearchTemplate',
deleteSearchTemplate :: SearchTemplateId -> BHRequest StatusIndependant Acknowledged
deleteSearchTemplate :: SearchTemplateId -> BHRequest StatusIndependant Acknowledged
deleteSearchTemplate (SearchTemplateId Text
tid) =
  Endpoint -> BHRequest StatusIndependant Acknowledged
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
delete [Text
Item Endpoint
"_scripts", Text
Item Endpoint
tid]

-- | For a given search, request a scroll for efficient streaming of
-- search results. Note that the search is put into 'SearchTypeScan'
-- mode and thus results will not be sorted. Combine this with
-- 'advanceScroll' to efficiently stream through the full result set
getInitialScroll ::
  (FromJSON a) =>
  IndexName ->
  Search ->
  BHRequest StatusDependant (ParsedEsResponse (SearchResult a))
getInitialScroll :: forall a.
FromJSON a =>
IndexName
-> Search
-> BHRequest StatusDependant (ParsedEsResponse (SearchResult a))
getInitialScroll IndexName
indexName Search
search' =
  BHRequest StatusDependant (SearchResult a)
-> BHRequest StatusDependant (ParsedEsResponse (SearchResult a))
forall a parsingContext.
BHRequest parsingContext a
-> BHRequest StatusDependant (ParsedEsResponse a)
withBHResponseParsedEsResponse (BHRequest StatusDependant (SearchResult a)
 -> BHRequest StatusDependant (ParsedEsResponse (SearchResult a)))
-> BHRequest StatusDependant (SearchResult a)
-> BHRequest StatusDependant (ParsedEsResponse (SearchResult a))
forall a b. (a -> b) -> a -> b
$ Endpoint -> Search -> BHRequest StatusDependant (SearchResult a)
forall a.
FromJSON a =>
Endpoint -> Search -> BHRequest StatusDependant (SearchResult a)
dispatchSearch Endpoint
endpoint Search
search
  where
    endpoint :: Endpoint
endpoint = [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_search"] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text
"scroll", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"1m")]
    sorting :: Maybe Sort
sorting = Sort -> Maybe Sort
forall a. a -> Maybe a
Just [DefaultSort -> SortSpec
DefaultSortSpec (DefaultSort -> SortSpec) -> DefaultSort -> SortSpec
forall a b. (a -> b) -> a -> b
$ FieldName -> SortOrder -> DefaultSort
mkSort (Text -> FieldName
FieldName Text
"_doc") SortOrder
Descending]
    search :: Search
search = Search
search' {sortBody = sorting}

-- | For a given search, request a scroll for efficient streaming of
-- search results. Combine this with 'advanceScroll' to efficiently
-- stream through the full result set. Note that this search respects
-- sorting and may be less efficient than 'getInitialScroll'.
getInitialSortedScroll ::
  (FromJSON a) =>
  IndexName ->
  Search ->
  BHRequest StatusDependant (SearchResult a)
getInitialSortedScroll :: forall a.
FromJSON a =>
IndexName -> Search -> BHRequest StatusDependant (SearchResult a)
getInitialSortedScroll IndexName
indexName Search
search = do
  Endpoint -> Search -> BHRequest StatusDependant (SearchResult a)
forall a.
FromJSON a =>
Endpoint -> Search -> BHRequest StatusDependant (SearchResult a)
dispatchSearch Endpoint
endpoint Search
search
  where
    endpoint :: Endpoint
endpoint = [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_search"] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text
"scroll", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"1m")]

-- | Use the given scroll to fetch the next page of documents. If there are no
-- further pages, 'SearchResult.searchHits.hits' will be '[]'.
advanceScroll ::
  (FromJSON a) =>
  ScrollId ->
  -- | How long should the snapshot of data be kept around? This timeout is updated every time 'advanceScroll' is used, so don't feel the need to set it to the entire duration of your search processing. Note that durations < 1s will be rounded up. Also note that 'NominalDiffTime' is an instance of Num so literals like 60 will be interpreted as seconds. 60s is a reasonable default.
  NominalDiffTime ->
  BHRequest StatusDependant (SearchResult a)
advanceScroll :: forall a.
FromJSON a =>
ScrollId
-> NominalDiffTime -> BHRequest StatusDependant (SearchResult a)
advanceScroll (ScrollId Text
sid) NominalDiffTime
scroll =
  Endpoint
-> ByteString -> BHRequest StatusDependant (SearchResult a)
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post [Text
Item Endpoint
"_search", Text
Item Endpoint
"scroll"] (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
scrollObject)
  where
    scrollTime :: Text
scrollTime = Integer -> Text
forall a. Show a => a -> Text
showText Integer
secs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"s"
    secs :: Integer
    secs :: Integer
secs = NominalDiffTime -> Integer
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round NominalDiffTime
scroll

    scrollObject :: Value
scrollObject =
      [Pair] -> Value
object
        [ Key
"scroll" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
scrollTime,
          Key
"scroll_id" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
sid
        ]

-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search'
--  to Nothing in case you only care about your 'Query' and 'Filter'. Use record update
--  syntax if you want to add things like aggregations or highlights while still using
--  this helper function.
--
-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
-- >>> mkSearch (Just query) Nothing
-- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, searchAfterKey = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}
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 = Maybe Sort
forall a. Maybe a
Nothing,
      aggBody :: Maybe Aggregations
aggBody = Maybe Aggregations
forall a. Maybe a
Nothing,
      highlight :: Maybe Highlights
highlight = Maybe Highlights
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 = Maybe [Value]
forall a. Maybe a
Nothing,
      fields :: Maybe [FieldName]
fields = Maybe [FieldName]
forall a. Maybe a
Nothing,
      scriptFields :: Maybe ScriptFields
scriptFields = Maybe ScriptFields
forall a. Maybe a
Nothing,
      source :: Maybe Source
source = Maybe Source
forall a. Maybe a
Nothing,
      suggestBody :: Maybe Suggest
suggestBody = Maybe Suggest
forall a. Maybe a
Nothing,
      pointInTime :: Maybe PointInTime
pointInTime = Maybe PointInTime
forall a. Maybe a
Nothing
    }

-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
--  the 'Query' and the 'Aggregation'.
--
-- >>> let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
-- >>> terms
-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
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 = Maybe Filter
forall a. Maybe a
Nothing,
      sortBody :: Maybe Sort
sortBody = Maybe Sort
forall a. Maybe a
Nothing,
      aggBody :: Maybe Aggregations
aggBody = Aggregations -> Maybe Aggregations
forall a. a -> Maybe a
Just Aggregations
mkSearchAggs,
      highlight :: Maybe Highlights
highlight = Maybe Highlights
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 = Maybe [Value]
forall a. Maybe a
Nothing,
      fields :: Maybe [FieldName]
fields = Maybe [FieldName]
forall a. Maybe a
Nothing,
      scriptFields :: Maybe ScriptFields
scriptFields = Maybe ScriptFields
forall a. Maybe a
Nothing,
      source :: Maybe Source
source = Maybe Source
forall a. Maybe a
Nothing,
      suggestBody :: Maybe Suggest
suggestBody = Maybe Suggest
forall a. Maybe a
Nothing,
      pointInTime :: Maybe PointInTime
pointInTime = Maybe PointInTime
forall a. Maybe a
Nothing
    }

-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
--  the 'Query' and the 'Aggregation'.
--
-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
-- >>> let search = mkHighlightSearch (Just query) testHighlight
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 = Maybe Filter
forall a. Maybe a
Nothing,
      sortBody :: Maybe Sort
sortBody = Maybe Sort
forall a. Maybe a
Nothing,
      aggBody :: Maybe Aggregations
aggBody = Maybe Aggregations
forall a. Maybe a
Nothing,
      highlight :: Maybe Highlights
highlight = Highlights -> Maybe Highlights
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 = Maybe [Value]
forall a. Maybe a
Nothing,
      fields :: Maybe [FieldName]
fields = Maybe [FieldName]
forall a. Maybe a
Nothing,
      scriptFields :: Maybe ScriptFields
scriptFields = Maybe ScriptFields
forall a. Maybe a
Nothing,
      source :: Maybe Source
source = Maybe Source
forall a. Maybe a
Nothing,
      suggestBody :: Maybe Suggest
suggestBody = Maybe Suggest
forall a. Maybe a
Nothing,
      pointInTime :: Maybe PointInTime
pointInTime = Maybe PointInTime
forall a. Maybe a
Nothing
    }

-- | 'mkSearchTemplate' is a helper function for defaulting additional fields of a 'SearchTemplate'
--  to Nothing. Use record update syntax if you want to add things.
mkSearchTemplate :: Either SearchTemplateId SearchTemplateSource -> TemplateQueryKeyValuePairs -> SearchTemplate
mkSearchTemplate :: Either SearchTemplateId SearchTemplateSource
-> TemplateQueryKeyValuePairs -> SearchTemplate
mkSearchTemplate Either SearchTemplateId SearchTemplateSource
id_ TemplateQueryKeyValuePairs
params = Either SearchTemplateId SearchTemplateSource
-> TemplateQueryKeyValuePairs
-> Maybe Bool
-> Maybe Bool
-> SearchTemplate
SearchTemplate Either SearchTemplateId SearchTemplateSource
id_ TemplateQueryKeyValuePairs
params Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

-- | 'pageSearch' is a helper function that takes a search and assigns the from
--   and size fields for the search. The from parameter defines the offset
--   from the first result you want to fetch. The size parameter allows you to
--   configure the maximum amount of hits to be returned.
--
-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
-- >>> let search = mkSearch (Just query) Nothing
-- >>> search
-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing, matchQueryBoost = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}
-- >>> pageSearch (From 10) (Size 100) search
-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing, matchQueryBoost = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 10, size = Size 100, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}
pageSearch ::
  -- | The result offset
  From ->
  -- | The number of results to return
  Size ->
  -- | The current seach
  Search ->
  -- | The paged search
  Search
pageSearch :: From -> Size -> Search -> Search
pageSearch From
resultOffset Size
pageSize Search
search = Search
search {from = resultOffset, size = pageSize}

boolQP :: Bool -> Text
boolQP :: Bool -> Text
boolQP Bool
True = Text
"true"
boolQP Bool
False = Text
"false"

countByIndex :: IndexName -> CountQuery -> BHRequest StatusDependant CountResponse
countByIndex :: IndexName -> CountQuery -> BHRequest StatusDependant CountResponse
countByIndex IndexName
indexName CountQuery
q =
  Endpoint -> ByteString -> BHRequest StatusDependant CountResponse
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post [IndexName -> Text
unIndexName IndexName
indexName, Text
Item Endpoint
"_count"] (CountQuery -> ByteString
forall a. ToJSON a => a -> ByteString
encode CountQuery
q)

reindex ::
  ReindexRequest ->
  BHRequest StatusDependant ReindexResponse
reindex :: ReindexRequest -> BHRequest StatusDependant ReindexResponse
reindex ReindexRequest
req =
  Endpoint -> ByteString -> BHRequest StatusDependant ReindexResponse
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post [Text
Item Endpoint
"_reindex"] (ReindexRequest -> ByteString
forall a. ToJSON a => a -> ByteString
encode ReindexRequest
req)

reindexAsync ::
  ReindexRequest ->
  BHRequest StatusDependant TaskNodeId
reindexAsync :: ReindexRequest -> BHRequest StatusDependant TaskNodeId
reindexAsync ReindexRequest
req =
  Endpoint -> ByteString -> BHRequest StatusDependant TaskNodeId
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> ByteString -> BHRequest contextualized body
post Endpoint
endpoint (ReindexRequest -> ByteString
forall a. ToJSON a => a -> ByteString
encode ReindexRequest
req)
  where
    endpoint :: Endpoint
endpoint = [Text
Item Endpoint
"_reindex"] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text
"wait_for_completion", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"false")]

getTask ::
  (FromJSON a) =>
  TaskNodeId ->
  BHRequest StatusDependant (TaskResponse a)
getTask :: forall a.
FromJSON a =>
TaskNodeId -> BHRequest StatusDependant (TaskResponse a)
getTask (TaskNodeId Text
task) =
  Endpoint -> BHRequest StatusDependant (TaskResponse a)
forall contextualized body.
(ParseBHResponse contextualized, FromJSON body) =>
Endpoint -> BHRequest contextualized body
get [Text
Item Endpoint
"_tasks", Text
Item Endpoint
task]