{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

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

    -- | The examples in this module assume the following code has been run.
    --   The :{ and :} will only work in GHCi. You'll only need the data types
    --   and typeclass instances for the functions that make use of them.
    -- $setup
    withBH,

    -- ** 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,
    getDocument,
    documentExists,
    deleteDocument,
    deleteByQuery,
    IndexedDocument (..),
    DeletedDocuments (..),
    DeletedDocumentsRetries (..),

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

    -- ** Templates
    storeSearchTemplate,
    getSearchTemplate,
    deleteSearchTemplate,

    -- ** Snapshot/Restore

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

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

    -- *** Restoring Snapshots
    restoreSnapshot,

    -- ** Nodes
    getNodesInfo,
    getNodesStats,

    -- ** Request Utilities
    encodeBulkOperations,
    encodeBulkOperation,

    -- * Authentication
    basicAuthHook,

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

    -- * Count
    countByIndex,

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

import Control.Applicative as A
import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Aeson
import Data.Aeson.Key
import qualified Data.Aeson.KeyMap as X
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Foldable (toList)
import qualified Data.List as LS (foldl')
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time.Clock
import qualified Data.Vector as V
import Database.Bloodhound.Internal.Client.BHRequest
import Database.Bloodhound.Types
import Network.HTTP.Client
import qualified Network.HTTP.Types.Method as NHTM
import qualified Network.URI as URI
import Prelude hiding (filter, head)

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> :set -XDeriveGeneric
-- >>> import Database.Bloodhound
-- >>> import Network.HTTP.Client
-- >>> let testServer = (Server "http://localhost:9200")
-- >>> let runBH' = withBH defaultManagerSettings testServer
-- >>> let testIndex = IndexName "twitter"
-- >>> let defaultIndexSettings = IndexSettings (ShardCount 1) (ReplicaCount 0)
-- >>> data TweetMapping = TweetMapping deriving (Eq, Show)
-- >>> _ <- runBH' $ deleteIndex testIndex
-- >>> _ <- runBH' $ deleteIndex (IndexName "didimakeanindex")
-- >>> import GHC.Generics
-- >>> import           Data.Time.Calendar        (Day (..))
-- >>> import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
-- >>> :{
-- instance ToJSON TweetMapping where
--          toJSON TweetMapping =
--            object ["properties" .=
--              object ["location" .=
--                object ["type" .= ("geo_point" :: Text)]]]
-- data Location = Location { lat :: Double
--                         , lon :: Double } deriving (Eq, Generic, Show)
-- data Tweet = Tweet { user     :: Text
--                    , postDate :: UTCTime
--                    , message  :: Text
--                    , age      :: Int
--                    , location :: Location } deriving (Eq, Generic, Show)
-- exampleTweet = Tweet { user     = "bitemyapp"
--                      , postDate = UTCTime
--                                   (ModifiedJulianDay 55000)
--                                   (secondsToDiffTime 10)
--                      , message  = "Use haskell!"
--                      , age      = 10000
--                      , location = Location 40.12 (-71.34) }
-- instance ToJSON   Tweet where
--  toJSON = genericToJSON defaultOptions
-- instance FromJSON Tweet where
--  parseJSON = genericParseJSON defaultOptions
-- instance ToJSON   Location where
--  toJSON = genericToJSON defaultOptions
-- instance FromJSON Location where
--  parseJSON = genericParseJSON defaultOptions
-- data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
-- instance FromJSON BulkTest where
--  parseJSON = genericParseJSON defaultOptions
-- instance ToJSON BulkTest where
--  toJSON = genericToJSON defaultOptions
-- :}

-- | '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 forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. Maybe a
Nothing
  | Int
n forall a. Ord a => a -> a -> Bool
> Int
1000 = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just (Int -> ShardCount
ShardCount Int
n)

-- | 'mkReplicaCount' 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 forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. Maybe a
Nothing
  | Int
n forall a. Ord a => a -> a -> Bool
> Int
1000 = forall a. Maybe a
Nothing -- ...
  | Bool
otherwise = forall a. a -> Maybe a
Just (Int -> ReplicaCount
ReplicaCount Int
n)

emptyBody :: L.ByteString
emptyBody :: ByteString
emptyBody = [Char] -> ByteString
L.pack [Char]
""

dispatch ::
  MonadBH m =>
  BHRequest body ->
  m (BHResponse body)
dispatch :: forall (m :: * -> *) body.
MonadBH m =>
BHRequest body -> m (BHResponse body)
dispatch BHRequest body
request = do
  BHEnv
env <- forall (m :: * -> *). MonadBH m => m BHEnv
getBHEnv
  let url :: Text
url = Server -> Endpoint -> Text
getEndpoint (BHEnv -> Server
bhServer BHEnv
env) (forall responseBody. BHRequest responseBody -> Endpoint
bhRequestEndpoint BHRequest body
request)
  Request
initReq <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => Text -> m Request
parseUrl' Text
url
  let reqHook :: Request -> IO Request
reqHook = BHEnv -> Request -> IO Request
bhRequestHook BHEnv
env
  let reqBody :: RequestBody
reqBody = ByteString -> RequestBody
RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe ByteString
emptyBody forall a b. (a -> b) -> a -> b
$ forall responseBody. BHRequest responseBody -> Maybe ByteString
bhRequestBody BHRequest body
request
  Request
req <-
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
      Request -> IO Request
reqHook forall a b. (a -> b) -> a -> b
$
        Request -> Request
setRequestIgnoreStatus forall a b. (a -> b) -> a -> b
$
          Request
initReq
            { method :: ByteString
method = forall responseBody. BHRequest responseBody -> ByteString
bhRequestMethod BHRequest body
request,
              requestHeaders :: RequestHeaders
requestHeaders =
                -- "application/x-ndjson" for bulk
                (HeaderName
"Content-Type", ByteString
"application/json") forall a. a -> [a] -> [a]
: Request -> RequestHeaders
requestHeaders Request
initReq,
              requestBody :: RequestBody
requestBody = RequestBody
reqBody
            }
  -- req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod
  --                                                            , requestBody = reqBody }
  let mgr :: Manager
mgr = BHEnv -> Manager
bhManager BHEnv
env
  forall body. Response ByteString -> BHResponse body
BHResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Request -> Manager -> IO (Response ByteString)
httpLbs Request
req Manager
mgr)

-- | Convenience function that sets up a manager and BHEnv and runs
-- the given set of bloodhound operations. Connections will be
-- pipelined automatically in accordance with the given manager
-- settings in IO. If you've got your own monad transformer stack, you
-- should use 'runBH' directly.
withBH :: ManagerSettings -> Server -> BH IO a -> IO a
withBH :: forall a. ManagerSettings -> Server -> BH IO a -> IO a
withBH ManagerSettings
ms Server
s BH IO a
f = do
  Manager
mgr <- ManagerSettings -> IO Manager
newManager ManagerSettings
ms
  let env :: BHEnv
env = Server -> Manager -> BHEnv
mkBHEnv Server
s Manager
mgr
  forall (m :: * -> *) a. BHEnv -> BH m a -> m a
runBH BHEnv
env BH IO a
f

-- Shortcut functions for HTTP methods
delete :: MonadBH m => Endpoint -> m (BHResponse body)
delete :: forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete = forall (m :: * -> *) body.
MonadBH m =>
BHRequest body -> m (BHResponse body)
dispatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. ByteString -> Endpoint -> BHRequest body
mkSimpleRequest ByteString
NHTM.methodDelete

deleteWithBody :: MonadBH m => Endpoint -> L.ByteString -> m (BHResponse body)
deleteWithBody :: forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
deleteWithBody Endpoint
endpoint = forall (m :: * -> *) body.
MonadBH m =>
BHRequest body -> m (BHResponse body)
dispatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. ByteString -> Endpoint -> ByteString -> BHRequest body
mkFullRequest ByteString
NHTM.methodDelete Endpoint
endpoint

get :: MonadBH m => Endpoint -> m (BHResponse body)
get :: forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get = forall (m :: * -> *) body.
MonadBH m =>
BHRequest body -> m (BHResponse body)
dispatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. ByteString -> Endpoint -> BHRequest body
mkSimpleRequest ByteString
NHTM.methodGet

head :: MonadBH m => Endpoint -> m (BHResponse body)
head :: forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
head = forall (m :: * -> *) body.
MonadBH m =>
BHRequest body -> m (BHResponse body)
dispatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. ByteString -> Endpoint -> BHRequest body
mkSimpleRequest ByteString
NHTM.methodHead

put :: MonadBH m => Endpoint -> L.ByteString -> m (BHResponse body)
put :: forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put Endpoint
endpoint = forall (m :: * -> *) body.
MonadBH m =>
BHRequest body -> m (BHResponse body)
dispatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. ByteString -> Endpoint -> ByteString -> BHRequest body
mkFullRequest ByteString
NHTM.methodPut Endpoint
endpoint

post :: MonadBH m => Endpoint -> L.ByteString -> m (BHResponse body)
post :: forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post Endpoint
endpoint = forall (m :: * -> *) body.
MonadBH m =>
BHRequest body -> m (BHResponse body)
dispatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. ByteString -> Endpoint -> ByteString -> BHRequest body
mkFullRequest ByteString
NHTM.methodPost Endpoint
endpoint

-- | 'getStatus' fetches the 'Status' of a 'Server'
--
-- >>> serverStatus <- runBH' getStatus
-- >>> fmap tagline (serverStatus)
-- Just "You Know, for Search"
getStatus :: MonadBH m => m (Either String Status)
getStatus :: forall (m :: * -> *). MonadBH m => m (Either [Char] Status)
getStatus =
  forall a. FromJSON a => BHResponse a -> Either [Char] a
eitherDecodeResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get []

-- | 'getSnapshotRepos' gets the definitions of a subset of the
-- defined snapshot repos.
getSnapshotRepos ::
  ( MonadBH m,
    MonadThrow m
  ) =>
  SnapshotRepoSelection ->
  m (ParsedEsResponse [GenericSnapshotRepo])
getSnapshotRepos :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
SnapshotRepoSelection -> m (ParsedEsResponse [GenericSnapshotRepo])
getSnapshotRepos SnapshotRepoSelection
sel =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GSRs -> [GenericSnapshotRepo]
unGSRs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_snapshot", Text
selectorSeg]
  where
    selectorSeg :: Text
selectorSeg = case SnapshotRepoSelection
sel of
      SnapshotRepoSelection
AllSnapshotRepos -> Text
"_all"
      SnapshotRepoList (SnapshotRepoPattern
p :| [SnapshotRepoPattern]
ps) -> Text -> [Text] -> Text
T.intercalate Text
"," (SnapshotRepoPattern -> Text
renderPat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SnapshotRepoPattern
p forall a. a -> [a] -> [a]
: [SnapshotRepoPattern]
ps))
    renderPat :: SnapshotRepoPattern -> Text
renderPat (RepoPattern Text
t) = Text
t
    renderPat (ExactRepo (SnapshotRepoName Text
t)) = Text
t

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

-- | Create or update a snapshot repo
updateSnapshotRepo ::
  ( MonadBH m,
    SnapshotRepo repo
  ) =>
  -- | Use 'defaultSnapshotRepoUpdateSettings' if unsure
  SnapshotRepoUpdateSettings ->
  repo ->
  m (BHResponse Acknowledged)
updateSnapshotRepo :: forall (m :: * -> *) repo.
(MonadBH m, SnapshotRepo repo) =>
SnapshotRepoUpdateSettings -> repo -> m (BHResponse Acknowledged)
updateSnapshotRepo SnapshotRepoUpdateSettings {Bool
repoUpdateVerify :: SnapshotRepoUpdateSettings -> Bool
repoUpdateVerify :: Bool
..} repo
repo =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put Endpoint
endpoint (forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    endpoint :: Endpoint
endpoint = [Text
"_snapshot", SnapshotRepoName -> Text
snapshotRepoName SnapshotRepoName
gSnapshotRepoName] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
    params :: [(Text, Maybe Text)]
params
      | Bool
repoUpdateVerify = []
      | Bool
otherwise = [(Text
"verify", forall a. a -> Maybe a
Just Text
"false")]
    body :: Value
body =
      [Pair] -> Value
object
        [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SnapshotRepoType
gSnapshotRepoType,
          Key
"settings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= GenericSnapshotRepoSettings
gSnapshotRepoSettings
        ]
    GenericSnapshotRepo {GenericSnapshotRepoSettings
SnapshotRepoType
SnapshotRepoName
gSnapshotRepoSettings :: GenericSnapshotRepo -> GenericSnapshotRepoSettings
gSnapshotRepoType :: GenericSnapshotRepo -> SnapshotRepoType
gSnapshotRepoName :: GenericSnapshotRepo -> SnapshotRepoName
gSnapshotRepoSettings :: GenericSnapshotRepoSettings
gSnapshotRepoType :: SnapshotRepoType
gSnapshotRepoName :: SnapshotRepoName
..} = forall r. SnapshotRepo r => r -> GenericSnapshotRepo
toGSnapshotRepo repo
repo

-- | 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 ::
  ( MonadBH m,
    MonadThrow m
  ) =>
  SnapshotRepoName ->
  m (ParsedEsResponse SnapshotVerification)
verifySnapshotRepo :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
SnapshotRepoName -> m (ParsedEsResponse SnapshotVerification)
verifySnapshotRepo (SnapshotRepoName Text
n) =
  forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
"_snapshot", Text
n, Text
"_verify"] ByteString
emptyBody

deleteSnapshotRepo :: MonadBH m => SnapshotRepoName -> m (BHResponse Acknowledged)
deleteSnapshotRepo :: forall (m :: * -> *).
MonadBH m =>
SnapshotRepoName -> m (BHResponse Acknowledged)
deleteSnapshotRepo (SnapshotRepoName Text
n) =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Text
"_snapshot", Text
n]

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

indexSelectionName :: IndexSelection -> Text
indexSelectionName :: IndexSelection -> Text
indexSelectionName IndexSelection
AllIndexes = Text
"_all"
indexSelectionName (IndexList (IndexName
i :| [IndexName]
is)) = Text -> [Text] -> Text
T.intercalate Text
"," (IndexName -> Text
renderIndex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IndexName
i forall a. a -> [a] -> [a]
: [IndexName]
is))
  where
    renderIndex :: IndexName -> Text
renderIndex (IndexName Text
n) = Text
n

-- | Get info about known snapshots given a pattern and repo name.
getSnapshots ::
  ( MonadBH m,
    MonadThrow m
  ) =>
  SnapshotRepoName ->
  SnapshotSelection ->
  m (ParsedEsResponse [SnapshotInfo])
getSnapshots :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
SnapshotRepoName
-> SnapshotSelection -> m (ParsedEsResponse [SnapshotInfo])
getSnapshots (SnapshotRepoName Text
repoName) SnapshotSelection
sel =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SIs -> [SnapshotInfo]
unSIs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_snapshot", Text
repoName, Text
snapPath]
  where
    snapPath :: Text
snapPath = case SnapshotSelection
sel of
      SnapshotSelection
AllSnapshots -> Text
"_all"
      SnapshotList (SnapshotPattern
s :| [SnapshotPattern]
ss) -> Text -> [Text] -> Text
T.intercalate Text
"," (SnapshotPattern -> Text
renderPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SnapshotPattern
s forall a. a -> [a] -> [a]
: [SnapshotPattern]
ss))
    renderPath :: SnapshotPattern -> Text
renderPath (SnapPattern Text
t) = Text
t
    renderPath (ExactSnap (SnapshotName Text
t)) = Text
t

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

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

-- | Delete a snapshot. Cancels if it is running.
deleteSnapshot :: MonadBH m => SnapshotRepoName -> SnapshotName -> m (BHResponse Acknowledged)
deleteSnapshot :: forall (m :: * -> *).
MonadBH m =>
SnapshotRepoName -> SnapshotName -> m (BHResponse Acknowledged)
deleteSnapshot (SnapshotRepoName Text
repoName) (SnapshotName Text
snapName) =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Text
"_snapshot", Text
repoName, Text
snapName]

-- | 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 ::
  MonadBH m =>
  SnapshotRepoName ->
  SnapshotName ->
  -- | Start with 'defaultSnapshotRestoreSettings' and customize
  -- from there for reasonable defaults.
  SnapshotRestoreSettings ->
  m (BHResponse Accepted)
restoreSnapshot :: forall (m :: * -> *).
MonadBH m =>
SnapshotRepoName
-> SnapshotName
-> SnapshotRestoreSettings
-> m (BHResponse Accepted)
restoreSnapshot (SnapshotRepoName Text
repoName) (SnapshotName Text
snapName) SnapshotRestoreSettings {Bool
Maybe (NonEmpty Text)
Maybe (NonEmpty RestoreRenameToken)
Maybe RestoreIndexSettings
Maybe RestoreRenamePattern
Maybe IndexSelection
snapRestoreIgnoreIndexSettings :: SnapshotRestoreSettings -> Maybe (NonEmpty Text)
snapRestoreIndexSettingsOverrides :: SnapshotRestoreSettings -> Maybe RestoreIndexSettings
snapRestoreIncludeAliases :: SnapshotRestoreSettings -> Bool
snapRestorePartial :: SnapshotRestoreSettings -> Bool
snapRestoreRenameReplacement :: SnapshotRestoreSettings -> Maybe (NonEmpty RestoreRenameToken)
snapRestoreRenamePattern :: SnapshotRestoreSettings -> Maybe RestoreRenamePattern
snapRestoreIncludeGlobalState :: SnapshotRestoreSettings -> Bool
snapRestoreIgnoreUnavailable :: SnapshotRestoreSettings -> Bool
snapRestoreIndices :: SnapshotRestoreSettings -> Maybe IndexSelection
snapRestoreWaitForCompletion :: SnapshotRestoreSettings -> Bool
snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
snapRestoreIncludeAliases :: Bool
snapRestorePartial :: Bool
snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
snapRestoreRenamePattern :: Maybe RestoreRenamePattern
snapRestoreIncludeGlobalState :: Bool
snapRestoreIgnoreUnavailable :: Bool
snapRestoreIndices :: Maybe IndexSelection
snapRestoreWaitForCompletion :: Bool
..} =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post Endpoint
endpoint (forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    endpoint :: Endpoint
endpoint = [Text
"_snapshot", Text
repoName, Text
snapName, Text
"_restore"] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
    params :: [(Text, Maybe Text)]
params = [(Text
"wait_for_completion", forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
snapRestoreWaitForCompletion))]
    body :: Value
body =
      [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$
        forall a. [Maybe a] -> [a]
catMaybes
          [ (Key
"indices" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexSelection -> Text
indexSelectionName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe IndexSelection
snapRestoreIndices,
            forall a. a -> Maybe a
Just (Key
"ignore_unavailable" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
snapRestoreIgnoreUnavailable),
            forall a. a -> Maybe a
Just (Key
"include_global_state" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
snapRestoreIncludeGlobalState),
            (Key
"rename_pattern" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RestoreRenamePattern
snapRestoreRenamePattern,
            (Key
"rename_replacement" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty RestoreRenameToken -> Text
renderTokens forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty RestoreRenameToken)
snapRestoreRenameReplacement,
            forall a. a -> Maybe a
Just (Key
"include_aliases" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
snapRestoreIncludeAliases),
            (Key
"index_settings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RestoreIndexSettings
snapRestoreIndexSettingsOverrides,
            (Key
"ignore_index_settings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty Text)
snapRestoreIgnoreIndexSettings
          ]
    renderTokens :: NonEmpty RestoreRenameToken -> Text
renderTokens (RestoreRenameToken
t :| [RestoreRenameToken]
ts) = forall a. Monoid a => [a] -> a
mconcat (RestoreRenameToken -> Text
renderToken forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RestoreRenameToken
t forall a. a -> [a] -> [a]
: [RestoreRenameToken]
ts))
    renderToken :: RestoreRenameToken -> Text
renderToken (RRTLit Text
t) = Text
t
    renderToken RestoreRenameToken
RRSubWholeMatch = Text
"$0"
    renderToken (RRSubGroup RRGroupRefNum
g) = [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (RRGroupRefNum -> Int
rrGroupRefNum RRGroupRefNum
g))

getNodesInfo ::
  ( MonadBH m,
    MonadThrow m
  ) =>
  NodeSelection ->
  m (ParsedEsResponse NodesInfo)
getNodesInfo :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
NodeSelection -> m (ParsedEsResponse NodesInfo)
getNodesInfo NodeSelection
sel =
  forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_nodes", Text
selectionSeg]
  where
    selectionSeg :: Text
selectionSeg = case NodeSelection
sel of
      NodeSelection
LocalNode -> Text
"_local"
      NodeList (NodeSelector
l :| [NodeSelector]
ls) -> Text -> [Text] -> Text
T.intercalate Text
"," (NodeSelector -> Text
selToSeg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NodeSelector
l forall a. a -> [a] -> [a]
: [NodeSelector]
ls))
      NodeSelection
AllNodes -> Text
"_all"
    selToSeg :: NodeSelector -> Text
selToSeg (NodeByName (NodeName Text
n)) = Text
n
    selToSeg (NodeByFullNodeId (FullNodeId Text
i)) = Text
i
    selToSeg (NodeByHost (Server Text
s)) = Text
s
    selToSeg (NodeByAttribute (NodeAttrName Text
a) Text
v) = Text
a forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
v

getNodesStats ::
  ( MonadBH m,
    MonadThrow m
  ) =>
  NodeSelection ->
  m (ParsedEsResponse NodesStats)
getNodesStats :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
NodeSelection -> m (ParsedEsResponse NodesStats)
getNodesStats NodeSelection
sel =
  forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_nodes", Text
selectionSeg, Text
"stats"]
  where
    selectionSeg :: Text
selectionSeg = case NodeSelection
sel of
      NodeSelection
LocalNode -> Text
"_local"
      NodeList (NodeSelector
l :| [NodeSelector]
ls) -> Text -> [Text] -> Text
T.intercalate Text
"," (NodeSelector -> Text
selToSeg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NodeSelector
l forall a. a -> [a] -> [a]
: [NodeSelector]
ls))
      NodeSelection
AllNodes -> Text
"_all"
    selToSeg :: NodeSelector -> Text
selToSeg (NodeByName (NodeName Text
n)) = Text
n
    selToSeg (NodeByFullNodeId (FullNodeId Text
i)) = Text
i
    selToSeg (NodeByHost (Server Text
s)) = Text
s
    selToSeg (NodeByAttribute (NodeAttrName Text
a) Text
v) = Text
a forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
v

-- | 'createIndex' 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 :: MonadBH m => IndexSettings -> IndexName -> m (BHResponse Acknowledged)
createIndex :: forall (m :: * -> *).
MonadBH m =>
IndexSettings -> IndexName -> m (BHResponse Acknowledged)
createIndex IndexSettings
indexSettings (IndexName Text
indexName) =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put [Text
indexName] forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode IndexSettings
indexSettings

-- | 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 ::
  MonadBH m =>
  [UpdatableIndexSetting] ->
  -- | shard count
  Int ->
  IndexName ->
  m (BHResponse Acknowledged)
createIndexWith :: forall (m :: * -> *).
MonadBH m =>
[UpdatableIndexSetting]
-> Int -> IndexName -> m (BHResponse Acknowledged)
createIndexWith [UpdatableIndexSetting]
updates Int
shards (IndexName Text
indexName) =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put [Text
indexName] ByteString
body
  where
    body :: ByteString
body =
      forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$
        [Pair] -> Value
object
          [ Key
"settings"
              forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Object] -> Object
deepMerge
                ( forall v. Key -> v -> KeyMap v
X.singleton Key
"index.number_of_shards" (forall a. ToJSON a => a -> Value
toJSON Int
shards)
                    forall a. a -> [a] -> [a]
: [Object
u | Object Object
u <- forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UpdatableIndexSetting]
updates]
                )
          ]

-- | 'flushIndex' will flush an index given a 'Server' and an 'IndexName'.
flushIndex :: MonadBH m => IndexName -> m (BHResponse ShardResult)
flushIndex :: forall (m :: * -> *).
MonadBH m =>
IndexName -> m (BHResponse ShardResult)
flushIndex (IndexName Text
indexName) =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
indexName, Text
"_flush"] ByteString
emptyBody

-- | 'deleteIndex' 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 :: MonadBH m => IndexName -> m (BHResponse Acknowledged)
deleteIndex :: forall (m :: * -> *).
MonadBH m =>
IndexName -> m (BHResponse Acknowledged)
deleteIndex (IndexName Text
indexName) =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Text
indexName]

-- | 'updateIndexSettings' 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 ::
  MonadBH m =>
  NonEmpty UpdatableIndexSetting ->
  IndexName ->
  m (BHResponse Acknowledged)
updateIndexSettings :: forall (m :: * -> *).
MonadBH m =>
NonEmpty UpdatableIndexSetting
-> IndexName -> m (BHResponse Acknowledged)
updateIndexSettings NonEmpty UpdatableIndexSetting
updates (IndexName Text
indexName) =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put [Text
indexName, Text
"_settings"] (forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    body :: Value
body = Object -> Value
Object ([Object] -> Object
deepMerge [Object
u | Object Object
u <- forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty UpdatableIndexSetting
updates])

getIndexSettings ::
  (MonadBH m, MonadThrow m) =>
  IndexName ->
  m (ParsedEsResponse IndexSettingsSummary)
getIndexSettings :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
IndexName -> m (ParsedEsResponse IndexSettingsSummary)
getIndexSettings (IndexName Text
indexName) =
  forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
indexName, Text
"_settings"]

-- | 'forceMergeIndex'
--
-- 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 :: MonadBH m => IndexSelection -> ForceMergeIndexSettings -> m (BHResponse ShardCount)
forceMergeIndex :: forall (m :: * -> *).
MonadBH m =>
IndexSelection
-> ForceMergeIndexSettings -> m (BHResponse ShardCount)
forceMergeIndex IndexSelection
ixs ForceMergeIndexSettings {Bool
Maybe Int
flushAfterOptimize :: ForceMergeIndexSettings -> Bool
onlyExpungeDeletes :: ForceMergeIndexSettings -> Bool
maxNumSegments :: ForceMergeIndexSettings -> Maybe Int
flushAfterOptimize :: Bool
onlyExpungeDeletes :: Bool
maxNumSegments :: Maybe Int
..} =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post Endpoint
endpoint ByteString
emptyBody
  where
    endpoint :: Endpoint
endpoint = [Text
indexName, Text
"_forcemerge"] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
    params :: [(Text, Maybe Text)]
params =
      forall a. [Maybe a] -> [a]
catMaybes
        [ (Text
"max_num_segments",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
showText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maxNumSegments,
          forall a. a -> Maybe a
Just (Text
"only_expunge_deletes", forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
onlyExpungeDeletes)),
          forall a. a -> Maybe a
Just (Text
"flush", forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
flushAfterOptimize))
        ]
    indexName :: Text
indexName = IndexSelection -> Text
indexSelectionName IndexSelection
ixs

deepMerge :: [Object] -> Object
deepMerge :: [Object] -> Object
deepMerge = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
LS.foldl' (forall v. (v -> v -> v) -> KeyMap v -> KeyMap v -> KeyMap v
X.unionWith Value -> Value -> Value
merge) forall a. Monoid a => a
mempty
  where
    merge :: Value -> Value -> Value
merge (Object Object
a) (Object Object
b) = Object -> Value
Object ([Object] -> Object
deepMerge [Object
a, Object
b])
    merge Value
_ Value
b = Value
b

doesExist :: MonadBH m => Endpoint -> m Bool
doesExist :: forall (m :: * -> *). MonadBH m => Endpoint -> m Bool
doesExist Endpoint
endpoint =
  forall a. BHResponse a -> Bool
isSuccess forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
head Endpoint
endpoint

-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
--   in IO
--
-- >>> exists <- runBH' $ indexExists testIndex
indexExists :: MonadBH m => IndexName -> m Bool
indexExists :: forall (m :: * -> *). MonadBH m => IndexName -> m Bool
indexExists (IndexName Text
indexName) =
  forall (m :: * -> *). MonadBH m => Endpoint -> m Bool
doesExist [Text
indexName]

-- | 'refreshIndex' 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 :: MonadBH m => IndexName -> m (BHResponse ShardResult)
refreshIndex :: forall (m :: * -> *).
MonadBH m =>
IndexName -> m (BHResponse ShardResult)
refreshIndex (IndexName Text
indexName) =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
indexName, Text
"_refresh"] ByteString
emptyBody

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

data HealthStatus = HealthStatus
  { HealthStatus -> Text
healthStatusClusterName :: Text,
    HealthStatus -> Text
healthStatusStatus :: Text,
    HealthStatus -> Bool
healthStatusTimedOut :: Bool,
    HealthStatus -> Int
healthStatusNumberOfNodes :: Int,
    HealthStatus -> Int
healthStatusNumberOfDataNodes :: Int,
    HealthStatus -> Int
healthStatusActivePrimaryShards :: Int,
    HealthStatus -> Int
healthStatusActiveShards :: Int,
    HealthStatus -> Int
healthStatusRelocatingShards :: Int,
    HealthStatus -> Int
healthStatusInitializingShards :: Int,
    HealthStatus -> Int
healthStatusUnassignedShards :: Int,
    HealthStatus -> Int
healthStatusDelayedUnassignedShards :: Int,
    HealthStatus -> Int
healthStatusNumberOfPendingTasks :: Int,
    HealthStatus -> Int
healthStatusNumberOfInFlightFetch :: Int,
    HealthStatus -> Int
healthStatusTaskMaxWaitingInQueueMillis :: Int,
    HealthStatus -> Float
healthStatusActiveShardsPercentAsNumber :: Float
  }
  deriving stock (HealthStatus -> HealthStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HealthStatus -> HealthStatus -> Bool
$c/= :: HealthStatus -> HealthStatus -> Bool
== :: HealthStatus -> HealthStatus -> Bool
$c== :: HealthStatus -> HealthStatus -> Bool
Eq, Int -> HealthStatus -> ShowS
[HealthStatus] -> ShowS
HealthStatus -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HealthStatus] -> ShowS
$cshowList :: [HealthStatus] -> ShowS
show :: HealthStatus -> [Char]
$cshow :: HealthStatus -> [Char]
showsPrec :: Int -> HealthStatus -> ShowS
$cshowsPrec :: Int -> HealthStatus -> ShowS
Show)

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

openOrCloseIndexes :: MonadBH m => OpenCloseIndex -> IndexName -> m (BHResponse Acknowledged)
openOrCloseIndexes :: forall (m :: * -> *).
MonadBH m =>
OpenCloseIndex -> IndexName -> m (BHResponse Acknowledged)
openOrCloseIndexes OpenCloseIndex
oci (IndexName Text
indexName) =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
indexName, Text
stringifyOCIndex] ByteString
emptyBody
  where
    stringifyOCIndex :: Text
stringifyOCIndex = case OpenCloseIndex
oci of
      OpenCloseIndex
OpenIndex -> Text
"_open"
      OpenCloseIndex
CloseIndex -> Text
"_close"

-- | 'openIndex' 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 :: MonadBH m => IndexName -> m (BHResponse Acknowledged)
openIndex :: forall (m :: * -> *).
MonadBH m =>
IndexName -> m (BHResponse Acknowledged)
openIndex = forall (m :: * -> *).
MonadBH m =>
OpenCloseIndex -> IndexName -> m (BHResponse Acknowledged)
openOrCloseIndexes OpenCloseIndex
OpenIndex

-- | 'closeIndex' 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 :: MonadBH m => IndexName -> m (BHResponse Acknowledged)
closeIndex :: forall (m :: * -> *).
MonadBH m =>
IndexName -> m (BHResponse Acknowledged)
closeIndex = forall (m :: * -> *).
MonadBH m =>
OpenCloseIndex -> IndexName -> m (BHResponse Acknowledged)
openOrCloseIndexes OpenCloseIndex
CloseIndex

-- | 'listIndices' returns a list of all index names on a given 'Server'
listIndices :: (MonadThrow m, MonadBH m) => m [IndexName]
listIndices :: forall (m :: * -> *). (MonadThrow m, MonadBH m) => m [IndexName]
listIndices =
  forall (m :: * -> *) body parsed.
(MonadThrow m, FromJSON body) =>
(body -> Either [Char] parsed) -> BHResponse body -> m parsed
parseEsResponseWith [Value] -> Either [Char] [IndexName]
parser forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_cat/indices?format=json"]
  where
    parser :: [Value] -> Either String [IndexName]
    parser :: [Value] -> Either [Char] [IndexName]
parser =
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a b. (a -> b) -> a -> b
$ \Value
val ->
        case Value
val of
          Object Object
obj ->
            case forall v. Key -> KeyMap v -> Maybe v
X.lookup Key
"index" Object
obj of
              (Just (String Text
txt)) -> forall a b. b -> Either a b
Right (Text -> IndexName
IndexName Text
txt)
              Maybe Value
v -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"indexVal in listIndices failed on non-string, was: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Maybe Value
v
          Value
v -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"One of the values parsed in listIndices wasn't an object, it was: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Value
v

-- | 'catIndices' returns a list of all index names on a given 'Server' as well as their doc counts
catIndices :: (MonadThrow m, MonadBH m) => m [(IndexName, Int)]
catIndices :: forall (m :: * -> *).
(MonadThrow m, MonadBH m) =>
m [(IndexName, Int)]
catIndices =
  forall (m :: * -> *) body parsed.
(MonadThrow m, FromJSON body) =>
(body -> Either [Char] parsed) -> BHResponse body -> m parsed
parseEsResponseWith [Value] -> Either [Char] [(IndexName, Int)]
parser forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_cat/indices?format=json"]
  where
    parser :: [Value] -> Either String [(IndexName, Int)]
    parser :: [Value] -> Either [Char] [(IndexName, Int)]
parser =
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a b. (a -> b) -> a -> b
$ \Value
val ->
        case Value
val of
          Object Object
obj ->
            case (forall v. Key -> KeyMap v -> Maybe v
X.lookup Key
"index" Object
obj, forall v. Key -> KeyMap v -> Maybe v
X.lookup Key
"docs.count" Object
obj) of
              (Just (String Text
txt), Just (String Text
docs)) -> forall a b. b -> Either a b
Right (Text -> IndexName
IndexName Text
txt, forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
docs))
              (Maybe Value, Maybe Value)
v -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"indexVal in catIndices failed on non-string, was: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (Maybe Value, Maybe Value)
v
          Value
v -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"One of the values parsed in catIndices wasn't an object, it was: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Value
v

-- | 'updateIndexAliases' 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 :: MonadBH m => NonEmpty IndexAliasAction -> m (BHResponse Acknowledged)
updateIndexAliases :: forall (m :: * -> *).
MonadBH m =>
NonEmpty IndexAliasAction -> m (BHResponse Acknowledged)
updateIndexAliases NonEmpty IndexAliasAction
actions =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
"_aliases"] (forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    body :: Value
body = [Pair] -> Value
object [Key
"actions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexAliasAction
actions]

-- | Get all aliases configured on the server.
getIndexAliases ::
  (MonadBH m, MonadThrow m) =>
  m (ParsedEsResponse IndexAliasesSummary)
getIndexAliases :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
m (ParsedEsResponse IndexAliasesSummary)
getIndexAliases =
  forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_aliases"]

-- | Delete a single alias, removing it from all indices it
--   is currently associated with.
deleteIndexAlias :: MonadBH m => IndexAliasName -> m (BHResponse Acknowledged)
deleteIndexAlias :: forall (m :: * -> *).
MonadBH m =>
IndexAliasName -> m (BHResponse Acknowledged)
deleteIndexAlias (IndexAliasName (IndexName Text
name)) =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Text
"_all", Text
"_alias", Text
name]

-- | 'putTemplate' 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 :: MonadBH m => IndexTemplate -> TemplateName -> m (BHResponse Acknowledged)
putTemplate :: forall (m :: * -> *).
MonadBH m =>
IndexTemplate -> TemplateName -> m (BHResponse Acknowledged)
putTemplate IndexTemplate
indexTemplate (TemplateName Text
templateName) =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put [Text
"_template", Text
templateName] (forall a. ToJSON a => a -> ByteString
encode IndexTemplate
indexTemplate)

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

-- | 'deleteTemplate' 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 :: MonadBH m => TemplateName -> m (BHResponse Acknowledged)
deleteTemplate :: forall (m :: * -> *).
MonadBH m =>
TemplateName -> m (BHResponse Acknowledged)
deleteTemplate (TemplateName Text
templateName) =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Text
"_template", Text
templateName]

-- | 'putMapping' 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 :: (MonadBH m, ToJSON a) => IndexName -> a -> m (BHResponse a)
putMapping :: forall (m :: * -> *) a.
(MonadBH m, ToJSON a) =>
IndexName -> a -> m (BHResponse a)
putMapping (IndexName Text
indexName) a
mapping =
  -- "_mapping" above is originally transposed
  -- erroneously. The correct API call is: "/INDEX/_mapping"
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put [Text
indexName, Text
"_mapping"] (forall a. ToJSON a => a -> ByteString
encode a
mapping)
{-# DEPRECATED putMapping "See <https://www.elastic.co/guide/en/elasticsearch/reference/7.17/removal-of-types.html>" #-}

versionCtlParams :: IndexDocumentSettings -> [(Text, Maybe Text)]
versionCtlParams :: IndexDocumentSettings -> [(Text, Maybe Text)]
versionCtlParams IndexDocumentSettings
cfg =
  case IndexDocumentSettings -> VersionControl
idsVersionControl IndexDocumentSettings
cfg of
    VersionControl
NoVersionControl -> []
    InternalVersion DocVersion
v -> DocVersion -> Text -> [(Text, Maybe Text)]
versionParams DocVersion
v Text
"internal"
    ExternalGT (ExternalDocVersion DocVersion
v) -> DocVersion -> Text -> [(Text, Maybe Text)]
versionParams DocVersion
v Text
"external_gt"
    ExternalGTE (ExternalDocVersion DocVersion
v) -> DocVersion -> Text -> [(Text, Maybe Text)]
versionParams DocVersion
v Text
"external_gte"
    ForceVersion (ExternalDocVersion DocVersion
v) -> DocVersion -> Text -> [(Text, Maybe Text)]
versionParams DocVersion
v Text
"force"
  where
    vt :: DocVersion -> Text
vt = forall a. Show a => a -> Text
showText forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocVersion -> Int
docVersionNumber
    versionParams :: DocVersion -> Text -> [(Text, Maybe Text)]
    versionParams :: DocVersion -> Text -> [(Text, Maybe Text)]
versionParams DocVersion
v Text
t =
      [ (Text
"version", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ DocVersion -> Text
vt DocVersion
v),
        (Text
"version_type", forall a. a -> Maybe a
Just Text
t)
      ]

-- | 'indexDocument' 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, MonadBH m) =>
  IndexName ->
  IndexDocumentSettings ->
  doc ->
  DocId ->
  m (BHResponse IndexedDocument)
indexDocument :: forall doc (m :: * -> *).
(ToJSON doc, MonadBH m) =>
IndexName
-> IndexDocumentSettings
-> doc
-> DocId
-> m (BHResponse IndexedDocument)
indexDocument (IndexName Text
indexName) IndexDocumentSettings
cfg doc
document (DocId Text
docId) =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put Endpoint
endpoint (forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    endpoint :: Endpoint
endpoint = [Text
indexName, Text
"_doc", Text
docId] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` IndexDocumentSettings -> DocId -> [(Text, Maybe Text)]
indexQueryString IndexDocumentSettings
cfg (Text -> DocId
DocId Text
docId)
    body :: Value
body = forall doc. ToJSON doc => IndexDocumentSettings -> doc -> Value
encodeDocument IndexDocumentSettings
cfg doc
document

data IndexedDocument = IndexedDocument
  { IndexedDocument -> Text
idxDocIndex :: Text,
    IndexedDocument -> Text
idxDocType :: Text,
    IndexedDocument -> Text
idxDocId :: Text,
    IndexedDocument -> Int
idxDocVersion :: Int,
    IndexedDocument -> Text
idxDocResult :: Text,
    IndexedDocument -> ShardResult
idxDocShards :: ShardResult,
    IndexedDocument -> Int
idxDocSeqNo :: Int,
    IndexedDocument -> Int
idxDocPrimaryTerm :: Int
  }
  deriving stock (IndexedDocument -> IndexedDocument -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDocument -> IndexedDocument -> Bool
$c/= :: IndexedDocument -> IndexedDocument -> Bool
== :: IndexedDocument -> IndexedDocument -> Bool
$c== :: IndexedDocument -> IndexedDocument -> Bool
Eq, Int -> IndexedDocument -> ShowS
[IndexedDocument] -> ShowS
IndexedDocument -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [IndexedDocument] -> ShowS
$cshowList :: [IndexedDocument] -> ShowS
show :: IndexedDocument -> [Char]
$cshow :: IndexedDocument -> [Char]
showsPrec :: Int -> IndexedDocument -> ShowS
$cshowsPrec :: Int -> IndexedDocument -> ShowS
Show)

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

-- | 'updateDocument' provides a way to perform an partial update of a
-- an already indexed document.
updateDocument ::
  (ToJSON patch, MonadBH m) =>
  IndexName ->
  IndexDocumentSettings ->
  patch ->
  DocId ->
  m (BHResponse IndexedDocument)
updateDocument :: forall doc (m :: * -> *).
(ToJSON doc, MonadBH m) =>
IndexName
-> IndexDocumentSettings
-> doc
-> DocId
-> m (BHResponse IndexedDocument)
updateDocument (IndexName Text
indexName) IndexDocumentSettings
cfg patch
patch (DocId Text
docId) =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post Endpoint
endpoint (forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    endpoint :: Endpoint
endpoint = [Text
indexName, Text
"_update", Text
docId] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` IndexDocumentSettings -> DocId -> [(Text, Maybe Text)]
indexQueryString IndexDocumentSettings
cfg (Text -> DocId
DocId Text
docId)
    body :: Value
body = [Pair] -> Value
object [Key
"doc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall doc. ToJSON doc => IndexDocumentSettings -> doc -> Value
encodeDocument IndexDocumentSettings
cfg patch
patch]

{-  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 forall a. Semigroup a => a -> a -> a
<> [(Text, Maybe Text)]
routeParams
  where
    routeParams :: [(Text, Maybe Text)]
routeParams = case IndexDocumentSettings -> Maybe JoinRelation
idsJoinRelation IndexDocumentSettings
cfg of
      Maybe JoinRelation
Nothing -> []
      Just (ParentDocument FieldName
_ RelationName
_) -> [(Text
"routing", forall a. a -> Maybe a
Just Text
docId)]
      Just (ChildDocument FieldName
_ RelationName
_ (DocId Text
pid)) -> [(Text
"routing", forall a. a -> Maybe a
Just Text
pid)]

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

-- | 'deleteDocument' is the primary way to delete a single document.
--
-- >>> _ <- runBH' $ deleteDocument testIndex (DocId "1")
deleteDocument :: MonadBH m => IndexName -> DocId -> m (BHResponse IndexedDocument)
deleteDocument :: forall (m :: * -> *).
MonadBH m =>
IndexName -> DocId -> m (BHResponse IndexedDocument)
deleteDocument (IndexName Text
indexName) (DocId Text
docId) = forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Text
indexName, Text
"_doc", Text
docId]

-- | 'deleteByQuery' performs a deletion on every document that matches a query.
--
-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
-- >>> _ <- runBH' $ deleteDocument testIndex query
deleteByQuery :: MonadBH m => IndexName -> Query -> m (BHResponse DeletedDocuments)
deleteByQuery :: forall (m :: * -> *).
MonadBH m =>
IndexName -> Query -> m (BHResponse DeletedDocuments)
deleteByQuery (IndexName Text
indexName) Query
query =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
indexName, Text
"_delete_by_query"] (forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    body :: Value
body = [Pair] -> Value
object [Key
"query" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Query
query]

data DeletedDocuments = DeletedDocuments
  { DeletedDocuments -> Int
delDocsTook :: Int,
    DeletedDocuments -> Bool
delDocsTimedOut :: Bool,
    DeletedDocuments -> Int
delDocsTotal :: Int,
    DeletedDocuments -> Int
delDocsDeleted :: Int,
    DeletedDocuments -> Int
delDocsBatches :: Int,
    DeletedDocuments -> Int
delDocsVersionConflicts :: Int,
    DeletedDocuments -> Int
delDocsNoops :: Int,
    DeletedDocuments -> DeletedDocumentsRetries
delDocsRetries :: DeletedDocumentsRetries,
    DeletedDocuments -> Int
delDocsThrottledMillis :: Int,
    DeletedDocuments -> Float
delDocsRequestsPerSecond :: Float,
    DeletedDocuments -> Int
delDocsThrottledUntilMillis :: Int,
    DeletedDocuments -> [Value]
delDocsFailures :: [Value] -- TODO find examples
  }
  deriving stock (DeletedDocuments -> DeletedDocuments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletedDocuments -> DeletedDocuments -> Bool
$c/= :: DeletedDocuments -> DeletedDocuments -> Bool
== :: DeletedDocuments -> DeletedDocuments -> Bool
$c== :: DeletedDocuments -> DeletedDocuments -> Bool
Eq, Int -> DeletedDocuments -> ShowS
[DeletedDocuments] -> ShowS
DeletedDocuments -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DeletedDocuments] -> ShowS
$cshowList :: [DeletedDocuments] -> ShowS
show :: DeletedDocuments -> [Char]
$cshow :: DeletedDocuments -> [Char]
showsPrec :: Int -> DeletedDocuments -> ShowS
$cshowsPrec :: Int -> DeletedDocuments -> ShowS
Show)

instance FromJSON DeletedDocuments where
  parseJSON :: Value -> Parser DeletedDocuments
parseJSON =
    forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"DeletedDocuments" forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Int
-> Bool
-> Int
-> Int
-> Int
-> Int
-> Int
-> DeletedDocumentsRetries
-> Int
-> Float
-> Int
-> [Value]
-> DeletedDocuments
DeletedDocuments
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"took"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timed_out"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deleted"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"batches"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version_conflicts"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"noops"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"retries"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"throttled_millis"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"requests_per_second"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"throttled_until_millis"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"failures"

data DeletedDocumentsRetries = DeletedDocumentsRetries
  { DeletedDocumentsRetries -> Int
delDocsRetriesBulk :: Int,
    DeletedDocumentsRetries -> Int
delDocsRetriesSearch :: Int
  }
  deriving stock (DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
$c/= :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
== :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
$c== :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
Eq, Int -> DeletedDocumentsRetries -> ShowS
[DeletedDocumentsRetries] -> ShowS
DeletedDocumentsRetries -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DeletedDocumentsRetries] -> ShowS
$cshowList :: [DeletedDocumentsRetries] -> ShowS
show :: DeletedDocumentsRetries -> [Char]
$cshow :: DeletedDocumentsRetries -> [Char]
showsPrec :: Int -> DeletedDocumentsRetries -> ShowS
$cshowsPrec :: Int -> DeletedDocumentsRetries -> ShowS
Show)

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

-- | 'bulk' 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 :: MonadBH m => V.Vector BulkOperation -> m (BHResponse a)
bulk :: forall (m :: * -> *) a.
MonadBH m =>
Vector BulkOperation -> m (BHResponse a)
bulk =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
"_bulk"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector BulkOperation -> ByteString
encodeBulkOperations

-- | 'encodeBulkOperations' 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 =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BulkOperation -> ByteString
encodeBulkOperation Vector BulkOperation
stream
    mashedTaters :: Builder
mashedTaters =
      Builder -> Vector ByteString -> Builder
mash (forall a. Monoid a => a
mempty :: Builder) Vector ByteString
blobs
    collapsed :: ByteString
collapsed =
      Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a -> a -> a
mappend Builder
mashedTaters (ByteString -> Builder
byteString ByteString
"\n")
    mash :: Builder -> V.Vector L.ByteString -> Builder
    mash :: Builder -> Vector ByteString -> Builder
mash = forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' (\Builder
b ByteString
x -> Builder
b forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
"\n" forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
lazyByteString ByteString
x)

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

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

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

-- | 'encodeBulkOperation' 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 Text
indexName) (DocId Text
docId) Value
value) = ByteString
blob
  where
    metadata :: Value
metadata = Text -> Text -> Text -> Value
mkBulkStreamValue Text
"index" Text
indexName Text
docId
    blob :: ByteString
blob = forall a. ToJSON a => a -> ByteString
encode Value
metadata forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" forall a. Monoid a => a -> a -> a
`mappend` forall a. ToJSON a => a -> ByteString
encode Value
value
encodeBulkOperation (BulkIndexAuto (IndexName Text
indexName) Value
value) = ByteString
blob
  where
    metadata :: Value
metadata = Text -> Text -> Value
mkBulkStreamValueAuto Text
"index" Text
indexName
    blob :: ByteString
blob = forall a. ToJSON a => a -> ByteString
encode Value
metadata forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" forall a. Monoid a => a -> a -> a
`mappend` forall a. ToJSON a => a -> ByteString
encode Value
value
encodeBulkOperation (BulkIndexEncodingAuto (IndexName Text
indexName) Encoding
encoding) = Builder -> ByteString
toLazyByteString Builder
blob
  where
    metadata :: Encoding
metadata = forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Text -> Value
mkBulkStreamValueAuto Text
"index" Text
indexName)
    blob :: Builder
blob = forall tag. Encoding' tag -> Builder
fromEncoding Encoding
metadata forall a. Semigroup a => a -> a -> a
<> Builder
"\n" forall a. Semigroup a => a -> a -> a
<> forall tag. Encoding' tag -> Builder
fromEncoding Encoding
encoding
encodeBulkOperation (BulkCreate (IndexName Text
indexName) (DocId Text
docId) Value
value) = ByteString
blob
  where
    metadata :: Value
metadata = Text -> Text -> Text -> Value
mkBulkStreamValue Text
"create" Text
indexName Text
docId
    blob :: ByteString
blob = forall a. ToJSON a => a -> ByteString
encode Value
metadata forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" forall a. Monoid a => a -> a -> a
`mappend` forall a. ToJSON a => a -> ByteString
encode Value
value
encodeBulkOperation (BulkDelete (IndexName Text
indexName) (DocId Text
docId)) = ByteString
blob
  where
    metadata :: Value
metadata = Text -> Text -> Text -> Value
mkBulkStreamValue Text
"delete" Text
indexName Text
docId
    blob :: ByteString
blob = forall a. ToJSON a => a -> ByteString
encode Value
metadata
encodeBulkOperation (BulkUpdate (IndexName Text
indexName) (DocId Text
docId) Value
value) = ByteString
blob
  where
    metadata :: Value
metadata = Text -> Text -> Text -> Value
mkBulkStreamValue Text
"update" Text
indexName Text
docId
    doc :: Value
doc = [Pair] -> Value
object [Key
"doc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
value]
    blob :: ByteString
blob = forall a. ToJSON a => a -> ByteString
encode Value
metadata forall a. Monoid a => a -> a -> a
`mappend` ByteString
"\n" forall a. Monoid a => a -> a -> a
`mappend` forall a. ToJSON a => a -> ByteString
encode Value
doc
encodeBulkOperation
  ( BulkUpsert
      (IndexName Text
indexName)
      (DocId Text
docId)
      UpsertPayload
payload
      [UpsertActionMetadata]
actionMeta
    ) = ByteString
blob
    where
      metadata :: Value
metadata = [UpsertActionMetadata] -> Text -> Text -> Text -> Value
mkBulkStreamValueWithMeta [UpsertActionMetadata]
actionMeta Text
"update" Text
indexName Text
docId
      blob :: ByteString
blob = forall a. ToJSON a => a -> ByteString
encode Value
metadata forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" forall a. Semigroup a => a -> a -> a
<> forall a. ToJSON a => a -> ByteString
encode Value
doc
      doc :: Value
doc = case UpsertPayload
payload of
        UpsertDoc Value
value -> [Pair] -> Value
object [Key
"doc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
value, Key
"doc_as_upsert" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True]
        UpsertScript Bool
scriptedUpsert Script
script Value
value ->
          let scup :: [Pair]
scup = if Bool
scriptedUpsert then [Key
"scripted_upsert" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True] else []
              upsert :: [Pair]
upsert = [Key
"upsert" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
value]
           in case ([Pair] -> Value
object ([Pair]
scup forall a. Semigroup a => a -> a -> a
<> [Pair]
upsert), forall a. ToJSON a => a -> Value
toJSON Script
script) of
                (Object Object
obj, Object Object
jscript) -> Object -> Value
Object forall a b. (a -> b) -> a -> b
$ Object
jscript forall a. Semigroup a => a -> a -> a
<> Object
obj
                (Value, Value)
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible happened: serialising Script to Json should always be Object"
encodeBulkOperation (BulkCreateEncoding (IndexName Text
indexName) (DocId Text
docId) Encoding
encoding) =
  Builder -> ByteString
toLazyByteString Builder
blob
  where
    metadata :: Encoding
metadata = forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Text -> Text -> Value
mkBulkStreamValue Text
"create" Text
indexName Text
docId)
    blob :: Builder
blob = forall tag. Encoding' tag -> Builder
fromEncoding Encoding
metadata forall a. Semigroup a => a -> a -> a
<> Builder
"\n" forall a. Semigroup a => a -> a -> a
<> forall tag. Encoding' tag -> Builder
fromEncoding Encoding
encoding

-- | 'getDocument' 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, MonadBH m) => IndexName -> DocId -> m (BHResponse (EsResult a))
getDocument :: forall a (m :: * -> *).
(FromJSON a, MonadBH m) =>
IndexName -> DocId -> m (BHResponse (EsResult a))
getDocument (IndexName Text
indexName) (DocId Text
docId) =
  forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
indexName, Text
"_doc", Text
docId]

-- | 'documentExists' enables you to check if a document exists.
documentExists :: MonadBH m => IndexName -> DocId -> m Bool
documentExists :: forall (m :: * -> *). MonadBH m => IndexName -> DocId -> m Bool
documentExists (IndexName Text
indexName) (DocId Text
docId) =
  forall (m :: * -> *). MonadBH m => Endpoint -> m Bool
doesExist [Text
indexName, Text
"_doc", Text
docId]

dispatchSearch :: MonadBH m => Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch :: forall (m :: * -> *) a.
MonadBH m =>
Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch Endpoint
endpoint Search
search = forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post Endpoint
url' (forall a. ToJSON a => a -> ByteString
encode Search
search)
  where
    url' :: Endpoint
url' = Endpoint -> SearchType -> Endpoint
appendSearchTypeParam Endpoint
endpoint (Search -> SearchType
searchType Search
search)
    appendSearchTypeParam :: Endpoint -> SearchType -> Endpoint
    appendSearchTypeParam :: Endpoint -> SearchType -> Endpoint
appendSearchTypeParam Endpoint
originalUrl SearchType
st = Endpoint
originalUrl Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
      where
        stText :: Text
stText = Text
"search_type"
        params :: [(Text, Maybe Text)]
params
          | SearchType
st forall a. Eq a => a -> a -> Bool
== SearchType
SearchTypeDfsQueryThenFetch = [(Text
stText, forall a. a -> Maybe a
Just Text
"dfs_query_then_fetch")]
          -- 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 :: MonadBH m => Search -> m (BHResponse (SearchResult a))
searchAll :: forall (m :: * -> *) a.
MonadBH m =>
Search -> m (BHResponse (SearchResult a))
searchAll = forall (m :: * -> *) a.
MonadBH m =>
Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch [Text
"_search"]

-- | 'searchByIndex', 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 :: MonadBH m => IndexName -> Search -> m (BHResponse (SearchResult a))
searchByIndex :: forall (m :: * -> *) a.
MonadBH m =>
IndexName -> Search -> m (BHResponse (SearchResult a))
searchByIndex (IndexName Text
indexName) = forall (m :: * -> *) a.
MonadBH m =>
Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch [Text
indexName, Text
"_search"]

-- | 'searchByIndices' 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 :: MonadBH m => NonEmpty IndexName -> Search -> m (BHResponse (SearchResult a))
searchByIndices :: forall (m :: * -> *) a.
MonadBH m =>
NonEmpty IndexName -> Search -> m (BHResponse (SearchResult a))
searchByIndices NonEmpty IndexName
ixs = forall (m :: * -> *) a.
MonadBH m =>
Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch [Text
renderedIxs, Text
"_search"]
  where
    renderedIxs :: Text
renderedIxs = Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
',') (forall a b. (a -> b) -> [a] -> [b]
map (\(IndexName Text
t) -> Text
t) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexName
ixs))

dispatchSearchTemplate ::
  (FromJSON a, MonadBH m) =>
  Endpoint ->
  SearchTemplate ->
  m (BHResponse (SearchResult a))
dispatchSearchTemplate :: forall a (m :: * -> *).
(FromJSON a, MonadBH m) =>
Endpoint -> SearchTemplate -> m (BHResponse (SearchResult a))
dispatchSearchTemplate Endpoint
endpoint SearchTemplate
search = forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post Endpoint
endpoint forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode SearchTemplate
search

-- | 'searchByIndexTemplate', 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, MonadBH m) =>
  IndexName ->
  SearchTemplate ->
  m (BHResponse (SearchResult a))
searchByIndexTemplate :: forall a (m :: * -> *).
(FromJSON a, MonadBH m) =>
IndexName -> SearchTemplate -> m (BHResponse (SearchResult a))
searchByIndexTemplate (IndexName Text
indexName) = forall a (m :: * -> *).
(FromJSON a, MonadBH m) =>
Endpoint -> SearchTemplate -> m (BHResponse (SearchResult a))
dispatchSearchTemplate [Text
indexName, Text
"_search", Text
"template"]

-- | 'searchByIndicesTemplate' 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, MonadBH m) =>
  NonEmpty IndexName ->
  SearchTemplate ->
  m (BHResponse (SearchResult a))
searchByIndicesTemplate :: forall a (m :: * -> *).
(FromJSON a, MonadBH m) =>
NonEmpty IndexName
-> SearchTemplate -> m (BHResponse (SearchResult a))
searchByIndicesTemplate NonEmpty IndexName
ixs = forall a (m :: * -> *).
(FromJSON a, MonadBH m) =>
Endpoint -> SearchTemplate -> m (BHResponse (SearchResult a))
dispatchSearchTemplate [Text
renderedIxs, Text
"_search", Text
"template"]
  where
    renderedIxs :: Text
renderedIxs = Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
',') (forall a b. (a -> b) -> [a] -> [b]
map (\(IndexName Text
t) -> Text
t) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexName
ixs))

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

-- | 'getSearchTemplate', get info of an stored 'SearchTemplateSource'.
getSearchTemplate :: MonadBH m => SearchTemplateId -> m (BHResponse GetTemplateScript)
getSearchTemplate :: forall (m :: * -> *).
MonadBH m =>
SearchTemplateId -> m (BHResponse GetTemplateScript)
getSearchTemplate (SearchTemplateId Text
tid) = forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Text
"_scripts", Text
tid]

-- | 'storeSearchTemplate',
deleteSearchTemplate :: MonadBH m => SearchTemplateId -> m (BHResponse Acknowledged)
deleteSearchTemplate :: forall (m :: * -> *).
MonadBH m =>
SearchTemplateId -> m (BHResponse Acknowledged)
deleteSearchTemplate (SearchTemplateId Text
tid) = forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Text
"_scripts", Text
tid]

-- | 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, MonadThrow m, MonadBH m) =>
  IndexName ->
  Search ->
  m (ParsedEsResponse (SearchResult a))
getInitialScroll :: forall a (m :: * -> *).
(FromJSON a, MonadThrow m, MonadBH m) =>
IndexName -> Search -> m (ParsedEsResponse (SearchResult a))
getInitialScroll (IndexName Text
indexName) Search
search' =
  forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a.
MonadBH m =>
Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch Endpoint
endpoint Search
search
  where
    endpoint :: Endpoint
endpoint = [Text
indexName, Text
"_search"] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text
"scroll", forall a. a -> Maybe a
Just Text
"1m")]
    sorting :: Maybe Sort
sorting = forall a. a -> Maybe a
Just [DefaultSort -> SortSpec
DefaultSortSpec forall a b. (a -> b) -> a -> b
$ FieldName -> SortOrder -> DefaultSort
mkSort (Text -> FieldName
FieldName Text
"_doc") SortOrder
Descending]
    search :: Search
search = Search
search' {sortBody :: Maybe Sort
sortBody = Maybe Sort
sorting}

-- | 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, MonadThrow m, MonadBH m) =>
  IndexName ->
  Search ->
  m (ParsedEsResponse (SearchResult a))
getInitialSortedScroll :: forall a (m :: * -> *).
(FromJSON a, MonadThrow m, MonadBH m) =>
IndexName -> Search -> m (ParsedEsResponse (SearchResult a))
getInitialSortedScroll (IndexName Text
indexName) Search
search = do
  forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a.
MonadBH m =>
Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch Endpoint
endpoint Search
search
  where
    endpoint :: Endpoint
endpoint = [Text
indexName, Text
"_search"] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text
"scroll", forall a. a -> Maybe a
Just Text
"1m")]

scroll' ::
  (FromJSON a, MonadBH m, MonadThrow m) =>
  Maybe ScrollId ->
  m ([Hit a], Maybe ScrollId)
scroll' :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
scroll' Maybe ScrollId
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. Maybe a
Nothing)
scroll' (Just ScrollId
sid) = do
  ParsedEsResponse (SearchResult a)
res <- forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
ScrollId
-> NominalDiffTime -> m (ParsedEsResponse (SearchResult a))
advanceScroll ScrollId
sid NominalDiffTime
60
  case ParsedEsResponse (SearchResult a)
res of
    Right SearchResult {Bool
Int
Maybe Text
Maybe AggregationResults
Maybe NamedSuggestionResponse
Maybe ScrollId
ShardResult
SearchHits a
pitId :: forall a. SearchResult a -> Maybe Text
suggest :: forall a. SearchResult a -> Maybe NamedSuggestionResponse
scrollId :: forall a. SearchResult a -> Maybe ScrollId
aggregations :: forall a. SearchResult a -> Maybe AggregationResults
searchHits :: forall a. SearchResult a -> SearchHits a
shards :: forall a. SearchResult a -> ShardResult
timedOut :: forall a. SearchResult a -> Bool
took :: forall a. SearchResult a -> Int
pitId :: Maybe Text
suggest :: Maybe NamedSuggestionResponse
scrollId :: Maybe ScrollId
aggregations :: Maybe AggregationResults
searchHits :: SearchHits a
shards :: ShardResult
timedOut :: Bool
took :: Int
..} -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. SearchHits a -> [Hit a]
hits SearchHits a
searchHits, Maybe ScrollId
scrollId)
    Left EsError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. Maybe a
Nothing)

-- | 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,
    MonadBH m,
    MonadThrow m
  ) =>
  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 ->
  m (ParsedEsResponse (SearchResult a))
advanceScroll :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
ScrollId
-> NominalDiffTime -> m (ParsedEsResponse (SearchResult a))
advanceScroll (ScrollId Text
sid) NominalDiffTime
scroll =
  forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
"_search", Text
"scroll"] (forall a. ToJSON a => a -> ByteString
encode Value
scrollObject)
  where
    scrollTime :: Text
scrollTime = forall a. Show a => a -> Text
showText Integer
secs forall a. Semigroup a => a -> a -> a
<> Text
"s"
    secs :: Integer
    secs :: Integer
secs = forall a b. (RealFrac a, Integral b) => a -> b
round NominalDiffTime
scroll

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

scanAccumulator ::
  (FromJSON a, MonadBH m, MonadThrow m) =>
  [Hit a] ->
  ([Hit a], Maybe ScrollId) ->
  m ([Hit a], Maybe ScrollId)
scanAccumulator :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
[Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
scanAccumulator [Hit a]
oldHits ([Hit a]
newHits, Maybe ScrollId
Nothing) = forall (m :: * -> *) a. Monad m => a -> m a
return ([Hit a]
oldHits forall a. [a] -> [a] -> [a]
++ [Hit a]
newHits, forall a. Maybe a
Nothing)
scanAccumulator [Hit a]
oldHits ([], Maybe ScrollId
_) = forall (m :: * -> *) a. Monad m => a -> m a
return ([Hit a]
oldHits, forall a. Maybe a
Nothing)
scanAccumulator [Hit a]
oldHits ([Hit a]
newHits, Maybe ScrollId
msid) = do
  ([Hit a]
newHits', Maybe ScrollId
msid') <- forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
scroll' Maybe ScrollId
msid
  forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
[Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
scanAccumulator ([Hit a]
oldHits forall a. [a] -> [a] -> [a]
++ [Hit a]
newHits) ([Hit a]
newHits', Maybe ScrollId
msid')

-- | 'scanSearch' uses the 'scroll' API of elastic,
-- for a given 'IndexName'. Note that this will
-- consume the entire search result set and will be doing O(n) list
-- appends so this may not be suitable for large result sets. In that
-- case, 'getInitialScroll' and 'advanceScroll' are good low level
-- tools. You should be able to hook them up trivially to conduit,
-- pipes, or your favorite streaming IO abstraction of choice. Note
-- that ordering on the search would destroy performance and thus is
-- ignored.
scanSearch ::
  (FromJSON a, MonadBH m, MonadThrow m) =>
  IndexName ->
  Search ->
  m [Hit a]
scanSearch :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
IndexName -> Search -> m [Hit a]
scanSearch IndexName
indexName Search
search = do
  ParsedEsResponse (SearchResult a)
initialSearchResult <- forall a (m :: * -> *).
(FromJSON a, MonadThrow m, MonadBH m) =>
IndexName -> Search -> m (ParsedEsResponse (SearchResult a))
getInitialScroll IndexName
indexName Search
search
  let ([Hit a]
hits', Maybe ScrollId
josh) = case ParsedEsResponse (SearchResult a)
initialSearchResult of
        Right SearchResult {Bool
Int
Maybe Text
Maybe AggregationResults
Maybe NamedSuggestionResponse
Maybe ScrollId
ShardResult
SearchHits a
pitId :: Maybe Text
suggest :: Maybe NamedSuggestionResponse
scrollId :: Maybe ScrollId
aggregations :: Maybe AggregationResults
searchHits :: SearchHits a
shards :: ShardResult
timedOut :: Bool
took :: Int
pitId :: forall a. SearchResult a -> Maybe Text
suggest :: forall a. SearchResult a -> Maybe NamedSuggestionResponse
scrollId :: forall a. SearchResult a -> Maybe ScrollId
aggregations :: forall a. SearchResult a -> Maybe AggregationResults
searchHits :: forall a. SearchResult a -> SearchHits a
shards :: forall a. SearchResult a -> ShardResult
timedOut :: forall a. SearchResult a -> Bool
took :: forall a. SearchResult a -> Int
..} -> (forall a. SearchHits a -> [Hit a]
hits SearchHits a
searchHits, Maybe ScrollId
scrollId)
        Left EsError
_ -> ([], forall a. Maybe a
Nothing)
  ([Hit a]
totalHits, Maybe ScrollId
_) <- forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
[Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
scanAccumulator [] ([Hit a]
hits', Maybe ScrollId
josh)
  forall (m :: * -> *) a. Monad m => a -> m a
return [Hit a]
totalHits

pitAccumulator ::
  (FromJSON a, MonadBH m, MonadThrow m) => Search -> [Hit a] -> m [Hit a]
pitAccumulator :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
Search -> [Hit a] -> m [Hit a]
pitAccumulator Search
search [Hit a]
oldHits = do
  BHResponse (SearchResult a)
resp <- forall (m :: * -> *) a.
MonadBH m =>
Search -> m (BHResponse (SearchResult a))
searchAll Search
search
  ParsedEsResponse (SearchResult a)
parsed <- forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse BHResponse (SearchResult a)
resp
  case ParsedEsResponse (SearchResult a)
parsed of
    Left EsError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    Right SearchResult a
searchResult -> case forall a. SearchHits a -> [Hit a]
hits (forall a. SearchResult a -> SearchHits a
searchHits SearchResult a
searchResult) of
      [] -> forall (m :: * -> *) a. Monad m => a -> m a
return [Hit a]
oldHits
      [Hit a]
newHits -> case (forall a. Hit a -> Maybe [Value]
hitSort forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [Hit a]
newHits, forall a. SearchResult a -> Maybe Text
pitId SearchResult a
searchResult) of
        (Maybe [Value]
Nothing, Maybe Text
Nothing) ->
          forall a. HasCallStack => [Char] -> a
error [Char]
"no point in time (PIT) ID or last sort value"
        (Just [Value]
_, Maybe Text
Nothing) -> forall a. HasCallStack => [Char] -> a
error [Char]
"no point in time (PIT) ID"
        (Maybe [Value]
Nothing, Maybe Text
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Hit a]
oldHits forall a. Semigroup a => a -> a -> a
<> [Hit a]
newHits)
        (Just [Value]
lastSort, Just Text
pitId') -> do
          let newSearch :: Search
newSearch =
                Search
search
                  { pointInTime :: Maybe PointInTime
pointInTime = forall a. a -> Maybe a
Just (Text -> Text -> PointInTime
PointInTime Text
pitId' Text
"1m"),
                    searchAfterKey :: Maybe [Value]
searchAfterKey = forall a. a -> Maybe a
Just [Value]
lastSort
                  }
          forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
Search -> [Hit a] -> m [Hit a]
pitAccumulator Search
newSearch ([Hit a]
oldHits forall a. Semigroup a => a -> a -> a
<> [Hit a]
newHits)

-- | 'pitSearch' uses the point in time (PIT) API of elastic, for a given
-- 'IndexName'. Requires Elasticsearch >=7.10. Note that this will consume the
-- entire search result set and will be doing O(n) list appends so this may
-- not be suitable for large result sets. In that case, the point in time API
-- should be used directly with `openPointInTime` and `closePointInTime`.
--
-- Note that 'pitSearch' utilizes the 'search_after' parameter under the hood,
-- which requires a non-empty 'sortBody' field in the provided 'Search' value.
-- Otherwise, 'pitSearch' will fail to return all matching documents.
--
-- For more information see
-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/point-in-time-api.html>.
pitSearch ::
  (FromJSON a, MonadBH m, MonadThrow m, Show a) => IndexName -> Search -> m [Hit a]
pitSearch :: forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m, Show a) =>
IndexName -> Search -> m [Hit a]
pitSearch IndexName
indexName Search
search = do
  ParsedEsResponse OpenPointInTimeResponse
openResp <- forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
IndexName -> m (ParsedEsResponse OpenPointInTimeResponse)
openPointInTime IndexName
indexName
  case ParsedEsResponse OpenPointInTimeResponse
openResp of
    Left EsError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    Right OpenPointInTimeResponse {Text
oPitId :: OpenPointInTimeResponse -> Text
oPitId :: Text
..} -> do
      let searchPIT :: Search
searchPIT = Search
search {pointInTime :: Maybe PointInTime
pointInTime = forall a. a -> Maybe a
Just (Text -> Text -> PointInTime
PointInTime Text
oPitId Text
"1m")}
      [Hit a]
hits <- forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
Search -> [Hit a] -> m [Hit a]
pitAccumulator Search
searchPIT []
      ParsedEsResponse ClosePointInTimeResponse
closeResp <- forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
ClosePointInTime -> m (ParsedEsResponse ClosePointInTimeResponse)
closePointInTime (Text -> ClosePointInTime
ClosePointInTime Text
oPitId)
      case ParsedEsResponse ClosePointInTimeResponse
closeResp of
        Left EsError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
        Right (ClosePointInTimeResponse Bool
False Int
_) ->
          forall a. HasCallStack => [Char] -> a
error [Char]
"failed to close point in time (PIT)"
        Right (ClosePointInTimeResponse Bool
True Int
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return [Hit a]
hits

-- | 'mkSearch' 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 = forall a. Maybe a
Nothing,
      aggBody :: Maybe Aggregations
aggBody = forall a. Maybe a
Nothing,
      highlight :: Maybe Highlights
highlight = forall a. Maybe a
Nothing,
      trackSortScores :: Bool
trackSortScores = Bool
False,
      from :: From
from = Int -> From
From Int
0,
      size :: Size
size = Int -> Size
Size Int
10,
      searchType :: SearchType
searchType = SearchType
SearchTypeQueryThenFetch,
      searchAfterKey :: Maybe [Value]
searchAfterKey = forall a. Maybe a
Nothing,
      fields :: Maybe [FieldName]
fields = forall a. Maybe a
Nothing,
      scriptFields :: Maybe ScriptFields
scriptFields = forall a. Maybe a
Nothing,
      source :: Maybe Source
source = forall a. Maybe a
Nothing,
      suggestBody :: Maybe Suggest
suggestBody = forall a. Maybe a
Nothing,
      pointInTime :: Maybe PointInTime
pointInTime = forall a. Maybe a
Nothing
    }

-- | 'mkAggregateSearch' 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 = forall a. Maybe a
Nothing,
      sortBody :: Maybe Sort
sortBody = forall a. Maybe a
Nothing,
      aggBody :: Maybe Aggregations
aggBody = forall a. a -> Maybe a
Just Aggregations
mkSearchAggs,
      highlight :: Maybe Highlights
highlight = forall a. Maybe a
Nothing,
      trackSortScores :: Bool
trackSortScores = Bool
False,
      from :: From
from = Int -> From
From Int
0,
      size :: Size
size = Int -> Size
Size Int
0,
      searchType :: SearchType
searchType = SearchType
SearchTypeQueryThenFetch,
      searchAfterKey :: Maybe [Value]
searchAfterKey = forall a. Maybe a
Nothing,
      fields :: Maybe [FieldName]
fields = forall a. Maybe a
Nothing,
      scriptFields :: Maybe ScriptFields
scriptFields = forall a. Maybe a
Nothing,
      source :: Maybe Source
source = forall a. Maybe a
Nothing,
      suggestBody :: Maybe Suggest
suggestBody = forall a. Maybe a
Nothing,
      pointInTime :: Maybe PointInTime
pointInTime = forall a. Maybe a
Nothing
    }

-- | 'mkHighlightSearch' 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 = forall a. Maybe a
Nothing,
      sortBody :: Maybe Sort
sortBody = forall a. Maybe a
Nothing,
      aggBody :: Maybe Aggregations
aggBody = forall a. Maybe a
Nothing,
      highlight :: Maybe Highlights
highlight = forall a. a -> Maybe a
Just Highlights
searchHighlights,
      trackSortScores :: Bool
trackSortScores = Bool
False,
      from :: From
from = Int -> From
From Int
0,
      size :: Size
size = Int -> Size
Size Int
10,
      searchType :: SearchType
searchType = SearchType
SearchTypeDfsQueryThenFetch,
      searchAfterKey :: Maybe [Value]
searchAfterKey = forall a. Maybe a
Nothing,
      fields :: Maybe [FieldName]
fields = forall a. Maybe a
Nothing,
      scriptFields :: Maybe ScriptFields
scriptFields = forall a. Maybe a
Nothing,
      source :: Maybe Source
source = forall a. Maybe a
Nothing,
      suggestBody :: Maybe Suggest
suggestBody = forall a. Maybe a
Nothing,
      pointInTime :: Maybe PointInTime
pointInTime = forall a. Maybe a
Nothing
    }

-- | 'mkSearchTemplate' 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 forall a. Maybe a
Nothing 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 :: From
from = From
resultOffset, size :: Size
size = Size
pageSize}

parseUrl' :: MonadThrow m => Text -> m Request
parseUrl' :: forall (m :: * -> *). MonadThrow m => Text -> m Request
parseUrl' Text
t = forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest ((Char -> Bool) -> ShowS
URI.escapeURIString Char -> Bool
URI.isAllowedInURI (Text -> [Char]
T.unpack Text
t))

-- | This is a hook that can be set via the 'bhRequestHook' function
-- that will authenticate all requests using an HTTP Basic
-- Authentication header. Note that it is *strongly* recommended that
-- this option only be used over an SSL connection.
--
-- >> (mkBHEnv myServer myManager) { bhRequestHook = basicAuthHook (EsUsername "myuser") (EsPassword "mypass") }
basicAuthHook :: Monad m => EsUsername -> EsPassword -> Request -> m Request
basicAuthHook :: forall (m :: * -> *).
Monad m =>
EsUsername -> EsPassword -> Request -> m Request
basicAuthHook (EsUsername Text
u) (EsPassword Text
p) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
applyBasicAuth ByteString
u' ByteString
p'
  where
    u' :: ByteString
u' = Text -> ByteString
T.encodeUtf8 Text
u
    p' :: ByteString
p' = Text -> ByteString
T.encodeUtf8 Text
p

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

countByIndex :: (MonadBH m, MonadThrow m) => IndexName -> CountQuery -> m (ParsedEsResponse CountResponse)
countByIndex :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
IndexName -> CountQuery -> m (ParsedEsResponse CountResponse)
countByIndex (IndexName Text
indexName) CountQuery
q =
  forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
indexName, Text
"_count"] (forall a. ToJSON a => a -> ByteString
encode CountQuery
q)

-- | 'openPointInTime' opens a point in time for an index given an 'IndexName'.
-- Note that the point in time should be closed with 'closePointInTime' as soon
-- as it is no longer needed.
--
-- For more information see
-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/point-in-time-api.html>.
openPointInTime ::
  (MonadBH m, MonadThrow m) =>
  IndexName ->
  m (ParsedEsResponse OpenPointInTimeResponse)
openPointInTime :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
IndexName -> m (ParsedEsResponse OpenPointInTimeResponse)
openPointInTime (IndexName Text
indexName) =
  forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
indexName, Text
"_pit?keep_alive=1m"] ByteString
emptyBody

-- | 'closePointInTime' closes a point in time given a 'ClosePointInTime'.
--
-- For more information see
-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/point-in-time-api.html>.
closePointInTime ::
  (MonadBH m, MonadThrow m) =>
  ClosePointInTime ->
  m (ParsedEsResponse ClosePointInTimeResponse)
closePointInTime :: forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
ClosePointInTime -> m (ParsedEsResponse ClosePointInTimeResponse)
closePointInTime ClosePointInTime
q = do
  forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
deleteWithBody [Text
"_pit"] (forall a. ToJSON a => a -> ByteString
encode ClosePointInTime
q)