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

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

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

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

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

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

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

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

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

post :: MonadBH m => Endpoint -> L.ByteString -> m (BHResponse body)
post :: Endpoint -> ByteString -> m (BHResponse body)
post Endpoint
endpoint = BHRequest body -> m (BHResponse body)
forall (m :: * -> *) body.
MonadBH m =>
BHRequest body -> m (BHResponse body)
dispatch (BHRequest body -> m (BHResponse body))
-> (ByteString -> BHRequest body)
-> ByteString
-> m (BHResponse body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Endpoint -> ByteString -> BHRequest body
forall body. Method -> Endpoint -> ByteString -> BHRequest body
mkFullRequest Method
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 :: m (Either [Char] Status)
getStatus =
  BHResponse Status -> Either [Char] Status
forall a. FromJSON a => BHResponse a -> Either [Char] a
eitherDecodeResponse (BHResponse Status -> Either [Char] Status)
-> m (BHResponse Status) -> m (Either [Char] Status)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endpoint -> m (BHResponse Status)
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 :: SnapshotRepoSelection -> m (ParsedEsResponse [GenericSnapshotRepo])
getSnapshotRepos SnapshotRepoSelection
sel =
  (Either EsError GSRs -> ParsedEsResponse [GenericSnapshotRepo])
-> m (Either EsError GSRs)
-> m (ParsedEsResponse [GenericSnapshotRepo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GSRs -> [GenericSnapshotRepo])
-> Either EsError GSRs -> ParsedEsResponse [GenericSnapshotRepo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GSRs -> [GenericSnapshotRepo]
unGSRs) (m (Either EsError GSRs)
 -> m (ParsedEsResponse [GenericSnapshotRepo]))
-> (BHResponse GSRs -> m (Either EsError GSRs))
-> BHResponse GSRs
-> m (ParsedEsResponse [GenericSnapshotRepo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHResponse GSRs -> m (Either EsError GSRs)
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse (BHResponse GSRs -> m (ParsedEsResponse [GenericSnapshotRepo]))
-> m (BHResponse GSRs)
-> m (ParsedEsResponse [GenericSnapshotRepo])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Endpoint -> m (BHResponse GSRs)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Item Endpoint
"_snapshot", Text
Item Endpoint
selectorSeg]
  where
    selectorSeg :: Text
selectorSeg = case SnapshotRepoSelection
sel of
      SnapshotRepoSelection
AllSnapshotRepos -> Text
"_all"
      SnapshotRepoList (SnapshotRepoPattern
p :| [SnapshotRepoPattern]
ps) -> Text -> [Text] -> Text
T.intercalate Text
"," (SnapshotRepoPattern -> Text
renderPat (SnapshotRepoPattern -> Text) -> [SnapshotRepoPattern] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SnapshotRepoPattern
p SnapshotRepoPattern
-> [SnapshotRepoPattern] -> [SnapshotRepoPattern]
forall a. a -> [a] -> [a]
: [SnapshotRepoPattern]
ps))
    renderPat :: SnapshotRepoPattern -> Text
renderPat (RepoPattern Text
t) = Text
t
    renderPat (ExactRepo (SnapshotRepoName Text
t)) = Text
t

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

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

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

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

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

-- | Create and start a snapshot
createSnapshot ::
  (MonadBH m) =>
  SnapshotRepoName ->
  SnapshotName ->
  SnapshotCreateSettings ->
  m (BHResponse Acknowledged)
createSnapshot :: 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
..} =
  Endpoint -> ByteString -> m (BHResponse Acknowledged)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put Endpoint
endpoint ByteString
body
  where
    endpoint :: Endpoint
endpoint = [Item Endpoint
"_snapshot", Text
Item Endpoint
repoName, Text
Item Endpoint
snapName] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
    params :: [(Text, Maybe Text)]
params = [(Text
"wait_for_completion", Text -> Maybe Text
forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
snapWaitForCompletion))]
    body :: ByteString
body = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Value
object [(Key, Value)]
prs
    prs :: [(Key, Value)]
prs =
      [Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
catMaybes
        [ (Key
"indices" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Text -> (Key, Value))
-> (IndexSelection -> Text) -> IndexSelection -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexSelection -> Text
indexSelectionName (IndexSelection -> (Key, Value))
-> Maybe IndexSelection -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe IndexSelection
snapIndices,
          (Key, Value) -> Maybe (Key, Value)
forall a. a -> Maybe a
Just (Key
"ignore_unavailable" Key -> Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
snapIgnoreUnavailable),
          (Key, Value) -> Maybe (Key, Value)
forall a. a -> Maybe a
Just (Key
"ignore_global_state" Key -> Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
snapIncludeGlobalState),
          (Key, Value) -> Maybe (Key, Value)
forall a. a -> Maybe a
Just (Key
"partial" Key -> Bool -> (Key, Value)
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 (IndexName -> Text) -> [IndexName] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IndexName
i IndexName -> [IndexName] -> [IndexName]
forall a. a -> [a] -> [a]
: [IndexName]
is))
  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 :: SnapshotRepoName
-> SnapshotSelection -> m (ParsedEsResponse [SnapshotInfo])
getSnapshots (SnapshotRepoName Text
repoName) SnapshotSelection
sel =
  (Either EsError SIs -> ParsedEsResponse [SnapshotInfo])
-> m (Either EsError SIs) -> m (ParsedEsResponse [SnapshotInfo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SIs -> [SnapshotInfo])
-> Either EsError SIs -> ParsedEsResponse [SnapshotInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SIs -> [SnapshotInfo]
unSIs) (m (Either EsError SIs) -> m (ParsedEsResponse [SnapshotInfo]))
-> (BHResponse SIs -> m (Either EsError SIs))
-> BHResponse SIs
-> m (ParsedEsResponse [SnapshotInfo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHResponse SIs -> m (Either EsError SIs)
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse (BHResponse SIs -> m (ParsedEsResponse [SnapshotInfo]))
-> m (BHResponse SIs) -> m (ParsedEsResponse [SnapshotInfo])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Endpoint -> m (BHResponse SIs)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Item Endpoint
"_snapshot", Text
Item Endpoint
repoName, Text
Item Endpoint
snapPath]
  where
    snapPath :: Text
snapPath = case SnapshotSelection
sel of
      SnapshotSelection
AllSnapshots -> Text
"_all"
      SnapshotList (SnapshotPattern
s :| [SnapshotPattern]
ss) -> Text -> [Text] -> Text
T.intercalate Text
"," (SnapshotPattern -> Text
renderPath (SnapshotPattern -> Text) -> [SnapshotPattern] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SnapshotPattern
s SnapshotPattern -> [SnapshotPattern] -> [SnapshotPattern]
forall a. a -> [a] -> [a]
: [SnapshotPattern]
ss))
    renderPath :: SnapshotPattern -> Text
renderPath (SnapPattern Text
t) = Text
t
    renderPath (ExactSnap (SnapshotName Text
t)) = Text
t

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

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

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

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

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

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

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

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

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

-- | 'deleteIndex' will delete an index given a 'Server' and an 'IndexName'.
--
-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
-- >>> isSuccess response
-- True
-- >>> runBH' $ indexExists (IndexName "didimakeanindex")
-- False
deleteIndex :: MonadBH m => IndexName -> m (BHResponse Acknowledged)
deleteIndex :: IndexName -> m (BHResponse Acknowledged)
deleteIndex (IndexName Text
indexName) =
  Endpoint -> m (BHResponse Acknowledged)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Text
Item Endpoint
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 :: NonEmpty UpdatableIndexSetting
-> IndexName -> m (BHResponse Acknowledged)
updateIndexSettings NonEmpty UpdatableIndexSetting
updates (IndexName Text
indexName) =
  Endpoint -> ByteString -> m (BHResponse Acknowledged)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put [Text
Item Endpoint
indexName, Item Endpoint
"_settings"] (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    body :: Value
body = Object -> Value
Object ([Object] -> Object
deepMerge [Object
u | Object Object
u <- UpdatableIndexSetting -> Value
forall a. ToJSON a => a -> Value
toJSON (UpdatableIndexSetting -> Value)
-> [UpdatableIndexSetting] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty UpdatableIndexSetting -> [UpdatableIndexSetting]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty UpdatableIndexSetting
updates])

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

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

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

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

doesExist :: MonadBH m => Endpoint -> m Bool
doesExist :: Endpoint -> m Bool
doesExist Endpoint
endpoint =
  BHResponse Any -> Bool
forall a. BHResponse a -> Bool
isSuccess (BHResponse Any -> Bool) -> m (BHResponse Any) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endpoint -> m (BHResponse Any)
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 :: IndexName -> m Bool
indexExists (IndexName Text
indexName) =
  Endpoint -> m Bool
forall (m :: * -> *). MonadBH m => Endpoint -> m Bool
doesExist [Text
Item Endpoint
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 :: IndexName -> m (BHResponse ShardResult)
refreshIndex (IndexName Text
indexName) =
  Endpoint -> ByteString -> m (BHResponse ShardResult)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
Item Endpoint
indexName, Item Endpoint
"_refresh"] ByteString
emptyBody

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

data HealthStatus = HealthStatus
  { HealthStatus -> Text
healthStatusClusterName :: Text,
    HealthStatus -> Text
healthStatusStatus :: Text,
    HealthStatus -> Bool
healthStatusTimedOut :: Bool,
    HealthStatus -> Int
healthStatusNumberOfNodes :: Int,
    HealthStatus -> Int
healthStatusNumberOfDataNodes :: Int,
    HealthStatus -> Int
healthStatusActivePrimaryShards :: Int,
    HealthStatus -> Int
healthStatusActiveShards :: Int,
    HealthStatus -> Int
healthStatusRelocatingShards :: Int,
    HealthStatus -> Int
healthStatusInitializingShards :: Int,
    HealthStatus -> Int
healthStatusUnassignedShards :: Int,
    HealthStatus -> Int
healthStatusDelayedUnassignedShards :: Int,
    HealthStatus -> Int
healthStatusNumberOfPendingTasks :: Int,
    HealthStatus -> Int
healthStatusNumberOfInFlightFetch :: Int,
    HealthStatus -> Int
healthStatusTaskMaxWaitingInQueueMillis :: Int,
    HealthStatus -> Float
healthStatusActiveShardsPercentAsNumber :: Float
  }
  deriving stock (HealthStatus -> HealthStatus -> Bool
(HealthStatus -> HealthStatus -> Bool)
-> (HealthStatus -> HealthStatus -> Bool) -> Eq HealthStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HealthStatus -> HealthStatus -> Bool
$c/= :: HealthStatus -> HealthStatus -> Bool
== :: HealthStatus -> HealthStatus -> Bool
$c== :: HealthStatus -> HealthStatus -> Bool
Eq, Int -> HealthStatus -> ShowS
[HealthStatus] -> ShowS
HealthStatus -> [Char]
(Int -> HealthStatus -> ShowS)
-> (HealthStatus -> [Char])
-> ([HealthStatus] -> ShowS)
-> Show HealthStatus
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 =
    [Char]
-> (Object -> Parser HealthStatus) -> Value -> Parser HealthStatus
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HealthStatus" ((Object -> Parser HealthStatus) -> Value -> Parser HealthStatus)
-> (Object -> Parser HealthStatus) -> Value -> Parser HealthStatus
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Text
-> Text
-> Bool
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Float
-> HealthStatus
HealthStatus
        (Text
 -> Text
 -> Bool
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Float
 -> HealthStatus)
-> Parser Text
-> Parser
     (Text
      -> Bool
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Float
      -> HealthStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cluster_name"
        Parser
  (Text
   -> Bool
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Float
   -> HealthStatus)
-> Parser Text
-> Parser
     (Bool
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Float
      -> HealthStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
        Parser
  (Bool
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Float
   -> HealthStatus)
-> Parser Bool
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Float
      -> HealthStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timed_out"
        Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Float
   -> HealthStatus)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Float
      -> HealthStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number_of_nodes"
        Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Float
   -> HealthStatus)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Float
      -> HealthStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number_of_data_nodes"
        Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Float
   -> HealthStatus)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Float
      -> HealthStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active_primary_shards"
        Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Float
   -> HealthStatus)
-> Parser Int
-> Parser
     (Int
      -> Int -> Int -> Int -> Int -> Int -> Int -> Float -> HealthStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active_shards"
        Parser
  (Int
   -> Int -> Int -> Int -> Int -> Int -> Int -> Float -> HealthStatus)
-> Parser Int
-> Parser
     (Int -> Int -> Int -> Int -> Int -> Int -> Float -> HealthStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"relocating_shards"
        Parser
  (Int -> Int -> Int -> Int -> Int -> Int -> Float -> HealthStatus)
-> Parser Int
-> Parser
     (Int -> Int -> Int -> Int -> Int -> Float -> HealthStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"initializing_shards"
        Parser (Int -> Int -> Int -> Int -> Int -> Float -> HealthStatus)
-> Parser Int
-> Parser (Int -> Int -> Int -> Int -> Float -> HealthStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"unassigned_shards"
        Parser (Int -> Int -> Int -> Int -> Float -> HealthStatus)
-> Parser Int
-> Parser (Int -> Int -> Int -> Float -> HealthStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"delayed_unassigned_shards"
        Parser (Int -> Int -> Int -> Float -> HealthStatus)
-> Parser Int -> Parser (Int -> Int -> Float -> HealthStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number_of_pending_tasks"
        Parser (Int -> Int -> Float -> HealthStatus)
-> Parser Int -> Parser (Int -> Float -> HealthStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number_of_in_flight_fetch"
        Parser (Int -> Float -> HealthStatus)
-> Parser Int -> Parser (Float -> HealthStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"task_max_waiting_in_queue_millis"
        Parser (Float -> HealthStatus)
-> Parser Float -> Parser HealthStatus
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Float
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active_shards_percent_as_number"

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

-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at
--   <http://www.elastic.co/guide/en/elasticsearch/reference/current/indices-open-close.html>
--
-- >>> response <- runBH' $ openIndex testIndex
openIndex :: MonadBH m => IndexName -> m (BHResponse Acknowledged)
openIndex :: IndexName -> m (BHResponse Acknowledged)
openIndex = OpenCloseIndex -> IndexName -> m (BHResponse Acknowledged)
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 :: IndexName -> m (BHResponse Acknowledged)
closeIndex = OpenCloseIndex -> IndexName -> m (BHResponse Acknowledged)
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 :: m [IndexName]
listIndices =
  ([Value] -> Either [Char] [IndexName])
-> BHResponse [Value] -> m [IndexName]
forall (m :: * -> *) body parsed.
(MonadThrow m, FromJSON body) =>
(body -> Either [Char] parsed) -> BHResponse body -> m parsed
parseEsResponseWith [Value] -> Either [Char] [IndexName]
parser (BHResponse [Value] -> m [IndexName])
-> m (BHResponse [Value]) -> m [IndexName]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Endpoint -> m (BHResponse [Value])
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Item Endpoint
"_cat/indices?format=json"]
  where
    parser :: [Value] -> Either String [IndexName]
    parser :: [Value] -> Either [Char] [IndexName]
parser =
      (Value -> Either [Char] IndexName)
-> [Value] -> Either [Char] [IndexName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Value -> Either [Char] IndexName)
 -> [Value] -> Either [Char] [IndexName])
-> (Value -> Either [Char] IndexName)
-> [Value]
-> Either [Char] [IndexName]
forall a b. (a -> b) -> a -> b
$ \Value
val ->
        case Value
val of
          Object Object
obj ->
            case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
X.lookup Key
"index" Object
obj of
              (Just (String Text
txt)) -> IndexName -> Either [Char] IndexName
forall a b. b -> Either a b
Right (Text -> IndexName
IndexName Text
txt)
              Maybe Value
v -> [Char] -> Either [Char] IndexName
forall a b. a -> Either a b
Left ([Char] -> Either [Char] IndexName)
-> [Char] -> Either [Char] IndexName
forall a b. (a -> b) -> a -> b
$ [Char]
"indexVal in listIndices failed on non-string, was: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe Value -> [Char]
forall a. Show a => a -> [Char]
show Maybe Value
v
          Value
v -> [Char] -> Either [Char] IndexName
forall a b. a -> Either a b
Left ([Char] -> Either [Char] IndexName)
-> [Char] -> Either [Char] IndexName
forall a b. (a -> b) -> a -> b
$ [Char]
"One of the values parsed in listIndices wasn't an object, it was: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> [Char]
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 :: m [(IndexName, Int)]
catIndices =
  ([Value] -> Either [Char] [(IndexName, Int)])
-> BHResponse [Value] -> m [(IndexName, Int)]
forall (m :: * -> *) body parsed.
(MonadThrow m, FromJSON body) =>
(body -> Either [Char] parsed) -> BHResponse body -> m parsed
parseEsResponseWith [Value] -> Either [Char] [(IndexName, Int)]
parser (BHResponse [Value] -> m [(IndexName, Int)])
-> m (BHResponse [Value]) -> m [(IndexName, Int)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Endpoint -> m (BHResponse [Value])
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Item Endpoint
"_cat/indices?format=json"]
  where
    parser :: [Value] -> Either String [(IndexName, Int)]
    parser :: [Value] -> Either [Char] [(IndexName, Int)]
parser =
      (Value -> Either [Char] (IndexName, Int))
-> [Value] -> Either [Char] [(IndexName, Int)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Value -> Either [Char] (IndexName, Int))
 -> [Value] -> Either [Char] [(IndexName, Int)])
-> (Value -> Either [Char] (IndexName, Int))
-> [Value]
-> Either [Char] [(IndexName, Int)]
forall a b. (a -> b) -> a -> b
$ \Value
val ->
        case Value
val of
          Object Object
obj ->
            case (Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
X.lookup Key
"index" Object
obj, Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
X.lookup Key
"docs.count" Object
obj) of
              (Just (String Text
txt), Just (String Text
docs)) -> (IndexName, Int) -> Either [Char] (IndexName, Int)
forall a b. b -> Either a b
Right (Text -> IndexName
IndexName Text
txt, [Char] -> Int
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
docs))
              (Maybe Value, Maybe Value)
v -> [Char] -> Either [Char] (IndexName, Int)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (IndexName, Int))
-> [Char] -> Either [Char] (IndexName, Int)
forall a b. (a -> b) -> a -> b
$ [Char]
"indexVal in catIndices failed on non-string, was: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Maybe Value, Maybe Value) -> [Char]
forall a. Show a => a -> [Char]
show (Maybe Value, Maybe Value)
v
          Value
v -> [Char] -> Either [Char] (IndexName, Int)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (IndexName, Int))
-> [Char] -> Either [Char] (IndexName, Int)
forall a b. (a -> b) -> a -> b
$ [Char]
"One of the values parsed in catIndices wasn't an object, it was: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> [Char]
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 :: NonEmpty IndexAliasAction -> m (BHResponse Acknowledged)
updateIndexAliases NonEmpty IndexAliasAction
actions =
  Endpoint -> ByteString -> m (BHResponse Acknowledged)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Item Endpoint
"_aliases"] (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    body :: Value
body = [(Key, Value)] -> Value
object [Key
"actions" Key -> [IndexAliasAction] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty IndexAliasAction -> [IndexAliasAction]
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 :: m (ParsedEsResponse IndexAliasesSummary)
getIndexAliases =
  BHResponse IndexAliasesSummary
-> m (ParsedEsResponse IndexAliasesSummary)
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse (BHResponse IndexAliasesSummary
 -> m (ParsedEsResponse IndexAliasesSummary))
-> m (BHResponse IndexAliasesSummary)
-> m (ParsedEsResponse IndexAliasesSummary)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Endpoint -> m (BHResponse IndexAliasesSummary)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Item Endpoint
"_aliases"]

-- | Delete a single alias, removing it from all indices it
--   is currently associated with.
deleteIndexAlias :: MonadBH m => IndexAliasName -> m (BHResponse Acknowledged)
deleteIndexAlias :: IndexAliasName -> m (BHResponse Acknowledged)
deleteIndexAlias (IndexAliasName (IndexName Text
name)) =
  Endpoint -> m (BHResponse Acknowledged)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
delete [Item Endpoint
"_all", Item Endpoint
"_alias", Text
Item Endpoint
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 :: IndexTemplate -> TemplateName -> m (BHResponse Acknowledged)
putTemplate IndexTemplate
indexTemplate (TemplateName Text
templateName) =
  Endpoint -> ByteString -> m (BHResponse Acknowledged)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put [Item Endpoint
"_template", Text
Item Endpoint
templateName] (IndexTemplate -> ByteString
forall a. ToJSON a => a -> ByteString
encode IndexTemplate
indexTemplate)

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

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

-- | 'putMapping' is an HTTP PUT and has upsert semantics. Mappings are schemas
-- for documents in indexes.
--
-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
-- >>> resp <- runBH' $ putMapping testIndex TweetMapping
-- >>> print resp
-- Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("content-type","application/json; charset=UTF-8"),("content-encoding","gzip"),("transfer-encoding","chunked")], responseBody = "{\"acknowledged\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
putMapping :: (MonadBH m, ToJSON a) => IndexName -> a -> m (BHResponse a)
putMapping :: IndexName -> a -> m (BHResponse a)
putMapping (IndexName Text
indexName) a
mapping =
  -- "_mapping" above is originally transposed
  -- erroneously. The correct API call is: "/INDEX/_mapping"
  Endpoint -> ByteString -> m (BHResponse a)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put [Text
Item Endpoint
indexName, Item Endpoint
"_mapping"] (a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
mapping)
{-# DEPRECATED putMapping "See <https://www.elastic.co/guide/en/elasticsearch/reference/7.17/removal-of-types.html>" #-}

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

-- | 'indexDocument' is the primary way to save a single document in
--   Elasticsearch. The document itself is simply something we can
--   convert into a JSON 'Value'. The 'DocId' will function as the
--   primary key for the document. You are encouraged to generate
--   your own id's and not rely on Elasticsearch's automatic id
--   generation. Read more about it here:
--   https://github.com/bitemyapp/bloodhound/issues/107
--
-- >>> resp <- runBH' $ indexDocument testIndex defaultIndexDocumentSettings exampleTweet (DocId "1")
-- >>> print resp
-- Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("content-type","application/json; charset=UTF-8"),("content-encoding","gzip"),("content-length","152")], responseBody = "{\"_index\":\"bloodhound-tests-twitter-1\",\"_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 :: IndexName
-> IndexDocumentSettings
-> doc
-> DocId
-> m (BHResponse IndexedDocument)
indexDocument (IndexName Text
indexName) IndexDocumentSettings
cfg doc
document (DocId Text
docId) =
  Endpoint -> ByteString -> m (BHResponse IndexedDocument)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
put Endpoint
endpoint (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    endpoint :: Endpoint
endpoint = [Text
Item Endpoint
indexName, Item Endpoint
"_doc", Text
Item Endpoint
docId] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` IndexDocumentSettings -> DocId -> [(Text, Maybe Text)]
indexQueryString IndexDocumentSettings
cfg (Text -> DocId
DocId Text
docId)
    body :: Value
body = IndexDocumentSettings -> doc -> Value
forall doc. ToJSON doc => IndexDocumentSettings -> doc -> Value
encodeDocument IndexDocumentSettings
cfg doc
document

data IndexedDocument = IndexedDocument
  { IndexedDocument -> Text
idxDocIndex :: Text,
    IndexedDocument -> Text
idxDocType :: Text,
    IndexedDocument -> Text
idxDocId :: Text,
    IndexedDocument -> Int
idxDocVersion :: Int,
    IndexedDocument -> Text
idxDocResult :: Text,
    IndexedDocument -> ShardCount
idxDocShards :: ShardCount,
    IndexedDocument -> Int
idxDocSeqNo :: Int,
    IndexedDocument -> Int
idxDocPrimaryTerm :: Int
  }
  deriving stock (IndexedDocument -> IndexedDocument -> Bool
(IndexedDocument -> IndexedDocument -> Bool)
-> (IndexedDocument -> IndexedDocument -> Bool)
-> Eq IndexedDocument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedDocument -> IndexedDocument -> Bool
$c/= :: IndexedDocument -> IndexedDocument -> Bool
== :: IndexedDocument -> IndexedDocument -> Bool
$c== :: IndexedDocument -> IndexedDocument -> Bool
Eq, Int -> IndexedDocument -> ShowS
[IndexedDocument] -> ShowS
IndexedDocument -> [Char]
(Int -> IndexedDocument -> ShowS)
-> (IndexedDocument -> [Char])
-> ([IndexedDocument] -> ShowS)
-> Show IndexedDocument
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 =
    [Char]
-> (Object -> Parser IndexedDocument)
-> Value
-> Parser IndexedDocument
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"IndexedDocument" ((Object -> Parser IndexedDocument)
 -> Value -> Parser IndexedDocument)
-> (Object -> Parser IndexedDocument)
-> Value
-> Parser IndexedDocument
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Text
-> Text
-> Text
-> Int
-> Text
-> ShardCount
-> Int
-> Int
-> IndexedDocument
IndexedDocument
        (Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> ShardCount
 -> Int
 -> Int
 -> IndexedDocument)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> Text
      -> ShardCount
      -> Int
      -> Int
      -> IndexedDocument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_index"
        Parser
  (Text
   -> Text
   -> Int
   -> Text
   -> ShardCount
   -> Int
   -> Int
   -> IndexedDocument)
-> Parser Text
-> Parser
     (Text
      -> Int -> Text -> ShardCount -> Int -> Int -> IndexedDocument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_type"
        Parser
  (Text
   -> Int -> Text -> ShardCount -> Int -> Int -> IndexedDocument)
-> Parser Text
-> Parser
     (Int -> Text -> ShardCount -> Int -> Int -> IndexedDocument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_id"
        Parser (Int -> Text -> ShardCount -> Int -> Int -> IndexedDocument)
-> Parser Int
-> Parser (Text -> ShardCount -> Int -> Int -> IndexedDocument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_version"
        Parser (Text -> ShardCount -> Int -> Int -> IndexedDocument)
-> Parser Text
-> Parser (ShardCount -> Int -> Int -> IndexedDocument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"result"
        Parser (ShardCount -> Int -> Int -> IndexedDocument)
-> Parser ShardCount -> Parser (Int -> Int -> IndexedDocument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser ShardCount
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_shards"
        Parser (Int -> Int -> IndexedDocument)
-> Parser Int -> Parser (Int -> IndexedDocument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_seq_no"
        Parser (Int -> IndexedDocument)
-> Parser Int -> Parser IndexedDocument
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_primary_term"

-- | 'updateDocument' provides a way to perform an partial update of a
-- an already indexed document.
updateDocument ::
  (ToJSON patch, MonadBH m) =>
  IndexName ->
  IndexDocumentSettings ->
  patch ->
  DocId ->
  m (BHResponse IndexedDocument)
updateDocument :: IndexName
-> IndexDocumentSettings
-> patch
-> DocId
-> m (BHResponse IndexedDocument)
updateDocument (IndexName Text
indexName) IndexDocumentSettings
cfg patch
patch (DocId Text
docId) =
  Endpoint -> ByteString -> m (BHResponse IndexedDocument)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post Endpoint
endpoint (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    endpoint :: Endpoint
endpoint = [Text
Item Endpoint
indexName, Item Endpoint
"_update", Text
Item Endpoint
docId] Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` IndexDocumentSettings -> DocId -> [(Text, Maybe Text)]
indexQueryString IndexDocumentSettings
cfg (Text -> DocId
DocId Text
docId)
    body :: Value
body = [(Key, Value)] -> Value
object [Key
"doc" Key -> Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= IndexDocumentSettings -> patch -> Value
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 [(Text, Maybe Text)]
-> [(Text, Maybe Text)] -> [(Text, Maybe Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Maybe Text)]
routeParams
  where
    routeParams :: [(Text, Maybe Text)]
routeParams = case IndexDocumentSettings -> Maybe JoinRelation
idsJoinRelation IndexDocumentSettings
cfg of
      Maybe JoinRelation
Nothing -> []
      Just (ParentDocument FieldName
_ RelationName
_) -> [(Text
"routing", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
docId)]
      Just (ChildDocument FieldName
_ RelationName
_ (DocId Text
pid)) -> [(Text
"routing", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pid)]

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

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

-- | 'deleteByQuery' performs a deletion on every document that matches a query.
--
-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
-- >>> _ <- runBH' $ deleteDocument testIndex query
deleteByQuery :: MonadBH m => IndexName -> Query -> m (BHResponse DeletedDocuments)
deleteByQuery :: IndexName -> Query -> m (BHResponse DeletedDocuments)
deleteByQuery (IndexName Text
indexName) Query
query =
  Endpoint -> ByteString -> m (BHResponse DeletedDocuments)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
Item Endpoint
indexName, Item Endpoint
"_delete_by_query"] (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    body :: Value
body = [(Key, Value)] -> Value
object [Key
"query" Key -> Query -> (Key, Value)
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
(DeletedDocuments -> DeletedDocuments -> Bool)
-> (DeletedDocuments -> DeletedDocuments -> Bool)
-> Eq DeletedDocuments
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]
(Int -> DeletedDocuments -> ShowS)
-> (DeletedDocuments -> [Char])
-> ([DeletedDocuments] -> ShowS)
-> Show DeletedDocuments
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 =
    [Char]
-> (Object -> Parser DeletedDocuments)
-> Value
-> Parser DeletedDocuments
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"DeletedDocuments" ((Object -> Parser DeletedDocuments)
 -> Value -> Parser DeletedDocuments)
-> (Object -> Parser DeletedDocuments)
-> Value
-> Parser DeletedDocuments
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Int
-> Bool
-> Int
-> Int
-> Int
-> Int
-> Int
-> DeletedDocumentsRetries
-> Int
-> Float
-> Int
-> [Value]
-> DeletedDocuments
DeletedDocuments
        (Int
 -> Bool
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> DeletedDocumentsRetries
 -> Int
 -> Float
 -> Int
 -> [Value]
 -> DeletedDocuments)
-> Parser Int
-> Parser
     (Bool
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> DeletedDocumentsRetries
      -> Int
      -> Float
      -> Int
      -> [Value]
      -> DeletedDocuments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"took"
        Parser
  (Bool
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> DeletedDocumentsRetries
   -> Int
   -> Float
   -> Int
   -> [Value]
   -> DeletedDocuments)
-> Parser Bool
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> DeletedDocumentsRetries
      -> Int
      -> Float
      -> Int
      -> [Value]
      -> DeletedDocuments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timed_out"
        Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> DeletedDocumentsRetries
   -> Int
   -> Float
   -> Int
   -> [Value]
   -> DeletedDocuments)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> DeletedDocumentsRetries
      -> Int
      -> Float
      -> Int
      -> [Value]
      -> DeletedDocuments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total"
        Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> DeletedDocumentsRetries
   -> Int
   -> Float
   -> Int
   -> [Value]
   -> DeletedDocuments)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> DeletedDocumentsRetries
      -> Int
      -> Float
      -> Int
      -> [Value]
      -> DeletedDocuments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deleted"
        Parser
  (Int
   -> Int
   -> Int
   -> DeletedDocumentsRetries
   -> Int
   -> Float
   -> Int
   -> [Value]
   -> DeletedDocuments)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> DeletedDocumentsRetries
      -> Int
      -> Float
      -> Int
      -> [Value]
      -> DeletedDocuments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"batches"
        Parser
  (Int
   -> Int
   -> DeletedDocumentsRetries
   -> Int
   -> Float
   -> Int
   -> [Value]
   -> DeletedDocuments)
-> Parser Int
-> Parser
     (Int
      -> DeletedDocumentsRetries
      -> Int
      -> Float
      -> Int
      -> [Value]
      -> DeletedDocuments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version_conflicts"
        Parser
  (Int
   -> DeletedDocumentsRetries
   -> Int
   -> Float
   -> Int
   -> [Value]
   -> DeletedDocuments)
-> Parser Int
-> Parser
     (DeletedDocumentsRetries
      -> Int -> Float -> Int -> [Value] -> DeletedDocuments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"noops"
        Parser
  (DeletedDocumentsRetries
   -> Int -> Float -> Int -> [Value] -> DeletedDocuments)
-> Parser DeletedDocumentsRetries
-> Parser (Int -> Float -> Int -> [Value] -> DeletedDocuments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser DeletedDocumentsRetries
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"retries"
        Parser (Int -> Float -> Int -> [Value] -> DeletedDocuments)
-> Parser Int
-> Parser (Float -> Int -> [Value] -> DeletedDocuments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"throttled_millis"
        Parser (Float -> Int -> [Value] -> DeletedDocuments)
-> Parser Float -> Parser (Int -> [Value] -> DeletedDocuments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Float
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"requests_per_second"
        Parser (Int -> [Value] -> DeletedDocuments)
-> Parser Int -> Parser ([Value] -> DeletedDocuments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"throttled_until_millis"
        Parser ([Value] -> DeletedDocuments)
-> Parser [Value] -> Parser DeletedDocuments
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"failures"

data DeletedDocumentsRetries = DeletedDocumentsRetries
  { DeletedDocumentsRetries -> Int
delDocsRetriesBulk :: Int,
    DeletedDocumentsRetries -> Int
delDocsRetriesSearch :: Int
  }
  deriving stock (DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
(DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool)
-> (DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool)
-> Eq DeletedDocumentsRetries
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
$c/= :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
== :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
$c== :: DeletedDocumentsRetries -> DeletedDocumentsRetries -> Bool
Eq, Int -> DeletedDocumentsRetries -> ShowS
[DeletedDocumentsRetries] -> ShowS
DeletedDocumentsRetries -> [Char]
(Int -> DeletedDocumentsRetries -> ShowS)
-> (DeletedDocumentsRetries -> [Char])
-> ([DeletedDocumentsRetries] -> ShowS)
-> Show DeletedDocumentsRetries
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 =
    [Char]
-> (Object -> Parser DeletedDocumentsRetries)
-> Value
-> Parser DeletedDocumentsRetries
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"DeletedDocumentsRetries" ((Object -> Parser DeletedDocumentsRetries)
 -> Value -> Parser DeletedDocumentsRetries)
-> (Object -> Parser DeletedDocumentsRetries)
-> Value
-> Parser DeletedDocumentsRetries
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Int -> Int -> DeletedDocumentsRetries
DeletedDocumentsRetries
        (Int -> Int -> DeletedDocumentsRetries)
-> Parser Int -> Parser (Int -> DeletedDocumentsRetries)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bulk"
        Parser (Int -> DeletedDocumentsRetries)
-> Parser Int -> Parser DeletedDocumentsRetries
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"search"

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

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

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

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

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

dispatchSearch :: MonadBH m => Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch :: Endpoint -> Search -> m (BHResponse (SearchResult a))
dispatchSearch Endpoint
endpoint Search
search = Endpoint -> ByteString -> m (BHResponse (SearchResult a))
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post Endpoint
url' (Search -> ByteString
forall a. ToJSON a => a -> ByteString
encode Search
search)
  where
    url' :: Endpoint
url' = Endpoint -> SearchType -> Endpoint
appendSearchTypeParam Endpoint
endpoint (Search -> SearchType
searchType Search
search)
    appendSearchTypeParam :: Endpoint -> SearchType -> Endpoint
    appendSearchTypeParam :: Endpoint -> SearchType -> Endpoint
appendSearchTypeParam Endpoint
originalUrl SearchType
st = Endpoint
originalUrl Endpoint -> [(Text, Maybe Text)] -> Endpoint
`withQueries` [(Text, Maybe Text)]
params
      where
        stText :: Text
stText = Text
"search_type"
        params :: [(Text, Maybe Text)]
params
          | SearchType
st SearchType -> SearchType -> Bool
forall a. Eq a => a -> a -> Bool
== SearchType
SearchTypeDfsQueryThenFetch = [(Text
stText, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"dfs_query_then_fetch")]
          -- used to catch 'SearchTypeQueryThenFetch', which is also the default
          | Bool
otherwise = []

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

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

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

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

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

-- | 'searchByIndicesTemplate' is a variant of 'searchByIndexTemplate' that executes a
--   'SearchTemplate' over many indices. This is much faster than using
--   'mapM' to 'searchByIndexTemplate' over a collection since it only
--   causes a single HTTP request to be emitted.
searchByIndicesTemplate ::
  (FromJSON a, MonadBH m) =>
  NonEmpty IndexName ->
  SearchTemplate ->
  m (BHResponse (SearchResult a))
searchByIndicesTemplate :: NonEmpty IndexName
-> SearchTemplate -> m (BHResponse (SearchResult a))
searchByIndicesTemplate NonEmpty IndexName
ixs = Endpoint -> SearchTemplate -> m (BHResponse (SearchResult a))
forall a (m :: * -> *).
(FromJSON a, MonadBH m) =>
Endpoint -> SearchTemplate -> m (BHResponse (SearchResult a))
dispatchSearchTemplate [Text
Item Endpoint
renderedIxs, Item Endpoint
"_search", Item Endpoint
"template"]
  where
    renderedIxs :: Text
renderedIxs = Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
',') ((IndexName -> Text) -> [IndexName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(IndexName Text
t) -> Text
t) (NonEmpty IndexName -> [IndexName]
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 :: SearchTemplateId
-> SearchTemplateSource -> m (BHResponse Acknowledged)
storeSearchTemplate (SearchTemplateId Text
tid) SearchTemplateSource
ts =
  Endpoint -> ByteString -> m (BHResponse Acknowledged)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Item Endpoint
"_scripts", Text
Item Endpoint
tid] (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body)
  where
    body :: Value
body = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
X.fromList [Key
"script" Key -> Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Object -> Value
Object (Key
"lang" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"mustache" Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Key
"source" Key -> SearchTemplateSource -> Object
forall 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 :: SearchTemplateId -> m (BHResponse GetTemplateScript)
getSearchTemplate (SearchTemplateId Text
tid) = Endpoint -> m (BHResponse GetTemplateScript)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> m (BHResponse body)
get [Item Endpoint
"_scripts", Text
Item Endpoint
tid]

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

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

scroll' ::
  (FromJSON a, MonadBH m, MonadThrow m) =>
  Maybe ScrollId ->
  m ([Hit a], Maybe ScrollId)
scroll' :: Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
scroll' Maybe ScrollId
Nothing = ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe ScrollId
forall a. Maybe a
Nothing)
scroll' (Just ScrollId
sid) = do
  ParsedEsResponse (SearchResult a)
res <- ScrollId
-> NominalDiffTime -> m (ParsedEsResponse (SearchResult a))
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
..} -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
forall (m :: * -> *) a. Monad m => a -> m a
return (SearchHits a -> [Hit a]
forall a. SearchHits a -> [Hit a]
hits SearchHits a
searchHits, Maybe ScrollId
scrollId)
    Left EsError
_ -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe ScrollId
forall a. Maybe a
Nothing)

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

    scrollObject :: Value
scrollObject =
      [(Key, Value)] -> Value
object
        [ Key
"scroll" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
scrollTime,
          Key
"scroll_id" Key -> Text -> (Key, Value)
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 :: [Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
scanAccumulator [Hit a]
oldHits ([Hit a]
newHits, Maybe ScrollId
Nothing) = ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Hit a]
oldHits [Hit a] -> [Hit a] -> [Hit a]
forall a. [a] -> [a] -> [a]
++ [Hit a]
newHits, Maybe ScrollId
forall a. Maybe a
Nothing)
scanAccumulator [Hit a]
oldHits ([], Maybe ScrollId
_) = ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Hit a]
oldHits, Maybe ScrollId
forall a. Maybe a
Nothing)
scanAccumulator [Hit a]
oldHits ([Hit a]
newHits, Maybe ScrollId
msid) = do
  ([Hit a]
newHits', Maybe ScrollId
msid') <- Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
scroll' Maybe ScrollId
msid
  [Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
[Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
scanAccumulator ([Hit a]
oldHits [Hit a] -> [Hit a] -> [Hit a]
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 :: IndexName -> Search -> m [Hit a]
scanSearch IndexName
indexName Search
search = do
  ParsedEsResponse (SearchResult a)
initialSearchResult <- IndexName -> Search -> m (ParsedEsResponse (SearchResult a))
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
..} -> (SearchHits a -> [Hit a]
forall a. SearchHits a -> [Hit a]
hits SearchHits a
searchHits, Maybe ScrollId
scrollId)
        Left EsError
_ -> ([], Maybe ScrollId
forall a. Maybe a
Nothing)
  ([Hit a]
totalHits, Maybe ScrollId
_) <- [Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
[Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
scanAccumulator [] ([Hit a]
hits', Maybe ScrollId
josh)
  [Hit a] -> m [Hit a]
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 :: Search -> [Hit a] -> m [Hit a]
pitAccumulator Search
search [Hit a]
oldHits = do
  BHResponse (SearchResult a)
resp <- Search -> m (BHResponse (SearchResult a))
forall (m :: * -> *) a.
MonadBH m =>
Search -> m (BHResponse (SearchResult a))
searchAll Search
search
  ParsedEsResponse (SearchResult a)
parsed <- BHResponse (SearchResult a)
-> m (ParsedEsResponse (SearchResult a))
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
_ -> [Hit a] -> m [Hit a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Right SearchResult a
searchResult -> case SearchHits a -> [Hit a]
forall a. SearchHits a -> [Hit a]
hits (SearchResult a -> SearchHits a
forall a. SearchResult a -> SearchHits a
searchHits SearchResult a
searchResult) of
      [] -> [Hit a] -> m [Hit a]
forall (m :: * -> *) a. Monad m => a -> m a
return [Hit a]
oldHits
      [Hit a]
newHits -> case (Hit a -> Maybe [Value]
forall a. Hit a -> Maybe [Value]
hitSort (Hit a -> Maybe [Value]) -> Hit a -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ [Hit a] -> Hit a
forall a. [a] -> a
last [Hit a]
newHits, SearchResult a -> Maybe Text
forall a. SearchResult a -> Maybe Text
pitId SearchResult a
searchResult) of
        (Maybe [Value]
Nothing, Maybe Text
Nothing) ->
          [Char] -> m [Hit a]
forall a. HasCallStack => [Char] -> a
error [Char]
"no point in time (PIT) ID or last sort value"
        (Just [Value]
_, Maybe Text
Nothing) -> [Char] -> m [Hit a]
forall a. HasCallStack => [Char] -> a
error [Char]
"no point in time (PIT) ID"
        (Maybe [Value]
Nothing, Maybe Text
_) -> [Hit a] -> m [Hit a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Hit a]
oldHits [Hit a] -> [Hit a] -> [Hit a]
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 = PointInTime -> Maybe PointInTime
forall a. a -> Maybe a
Just (Text -> Text -> PointInTime
PointInTime Text
pitId' Text
"1m"),
                    searchAfterKey :: Maybe [Value]
searchAfterKey = [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [Value]
lastSort
                  }
          Search -> [Hit a] -> m [Hit a]
forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
Search -> [Hit a] -> m [Hit a]
pitAccumulator Search
newSearch ([Hit a]
oldHits [Hit a] -> [Hit a] -> [Hit a]
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 :: IndexName -> Search -> m [Hit a]
pitSearch IndexName
indexName Search
search = do
  ParsedEsResponse OpenPointInTimeResponse
openResp <- IndexName -> m (ParsedEsResponse OpenPointInTimeResponse)
forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
IndexName -> m (ParsedEsResponse OpenPointInTimeResponse)
openPointInTime IndexName
indexName
  case ParsedEsResponse OpenPointInTimeResponse
openResp of
    Left EsError
_ -> [Hit a] -> m [Hit a]
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 = PointInTime -> Maybe PointInTime
forall a. a -> Maybe a
Just (Text -> Text -> PointInTime
PointInTime Text
oPitId Text
"1m")}
      [Hit a]
hits <- Search -> [Hit a] -> m [Hit a]
forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
Search -> [Hit a] -> m [Hit a]
pitAccumulator Search
searchPIT []
      ParsedEsResponse ClosePointInTimeResponse
closeResp <- ClosePointInTime -> m (ParsedEsResponse ClosePointInTimeResponse)
forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
ClosePointInTime -> m (ParsedEsResponse ClosePointInTimeResponse)
closePointInTime (Text -> ClosePointInTime
ClosePointInTime Text
oPitId)
      case ParsedEsResponse ClosePointInTimeResponse
closeResp of
        Left EsError
_ -> [Hit a] -> m [Hit a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        Right (ClosePointInTimeResponse Bool
False Int
_) ->
          [Char] -> m [Hit a]
forall a. HasCallStack => [Char] -> a
error [Char]
"failed to close point in time (PIT)"
        Right (ClosePointInTimeResponse Bool
True Int
_) -> [Hit a] -> m [Hit a]
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 :: Maybe Query
-> Maybe Filter
-> Maybe Sort
-> Maybe Aggregations
-> Maybe Highlights
-> Bool
-> From
-> Size
-> SearchType
-> Maybe [Value]
-> Maybe [FieldName]
-> Maybe ScriptFields
-> Maybe Source
-> Maybe Suggest
-> Maybe PointInTime
-> Search
Search
    { queryBody :: Maybe Query
queryBody = Maybe Query
query,
      filterBody :: Maybe Filter
filterBody = Maybe Filter
filter,
      sortBody :: Maybe Sort
sortBody = Maybe Sort
forall a. Maybe a
Nothing,
      aggBody :: Maybe Aggregations
aggBody = Maybe Aggregations
forall a. Maybe a
Nothing,
      highlight :: Maybe Highlights
highlight = Maybe Highlights
forall a. Maybe a
Nothing,
      trackSortScores :: Bool
trackSortScores = Bool
False,
      from :: From
from = Int -> From
From Int
0,
      size :: Size
size = Int -> Size
Size Int
10,
      searchType :: SearchType
searchType = SearchType
SearchTypeQueryThenFetch,
      searchAfterKey :: Maybe [Value]
searchAfterKey = Maybe [Value]
forall a. Maybe a
Nothing,
      fields :: Maybe [FieldName]
fields = Maybe [FieldName]
forall a. Maybe a
Nothing,
      scriptFields :: Maybe ScriptFields
scriptFields = Maybe ScriptFields
forall a. Maybe a
Nothing,
      source :: Maybe Source
source = Maybe Source
forall a. Maybe a
Nothing,
      suggestBody :: Maybe Suggest
suggestBody = Maybe Suggest
forall a. Maybe a
Nothing,
      pointInTime :: Maybe PointInTime
pointInTime = Maybe PointInTime
forall a. Maybe a
Nothing
    }

-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
--   the 'Query' and the 'Aggregation'.
--
-- >>> let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
-- >>> terms
-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
mkAggregateSearch :: Maybe Query -> Aggregations -> Search
mkAggregateSearch :: Maybe Query -> Aggregations -> Search
mkAggregateSearch Maybe Query
query Aggregations
mkSearchAggs =
  Search :: Maybe Query
-> Maybe Filter
-> Maybe Sort
-> Maybe Aggregations
-> Maybe Highlights
-> Bool
-> From
-> Size
-> SearchType
-> Maybe [Value]
-> Maybe [FieldName]
-> Maybe ScriptFields
-> Maybe Source
-> Maybe Suggest
-> Maybe PointInTime
-> Search
Search
    { queryBody :: Maybe Query
queryBody = Maybe Query
query,
      filterBody :: Maybe Filter
filterBody = Maybe Filter
forall a. Maybe a
Nothing,
      sortBody :: Maybe Sort
sortBody = Maybe Sort
forall a. Maybe a
Nothing,
      aggBody :: Maybe Aggregations
aggBody = Aggregations -> Maybe Aggregations
forall a. a -> Maybe a
Just Aggregations
mkSearchAggs,
      highlight :: Maybe Highlights
highlight = Maybe Highlights
forall a. Maybe a
Nothing,
      trackSortScores :: Bool
trackSortScores = Bool
False,
      from :: From
from = Int -> From
From Int
0,
      size :: Size
size = Int -> Size
Size Int
0,
      searchType :: SearchType
searchType = SearchType
SearchTypeQueryThenFetch,
      searchAfterKey :: Maybe [Value]
searchAfterKey = Maybe [Value]
forall a. Maybe a
Nothing,
      fields :: Maybe [FieldName]
fields = Maybe [FieldName]
forall a. Maybe a
Nothing,
      scriptFields :: Maybe ScriptFields
scriptFields = Maybe ScriptFields
forall a. Maybe a
Nothing,
      source :: Maybe Source
source = Maybe Source
forall a. Maybe a
Nothing,
      suggestBody :: Maybe Suggest
suggestBody = Maybe Suggest
forall a. Maybe a
Nothing,
      pointInTime :: Maybe PointInTime
pointInTime = Maybe PointInTime
forall a. Maybe a
Nothing
    }

-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
--   the 'Query' and the 'Aggregation'.
--
-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
-- >>> let search = mkHighlightSearch (Just query) testHighlight
mkHighlightSearch :: Maybe Query -> Highlights -> Search
mkHighlightSearch :: Maybe Query -> Highlights -> Search
mkHighlightSearch Maybe Query
query Highlights
searchHighlights =
  Search :: Maybe Query
-> Maybe Filter
-> Maybe Sort
-> Maybe Aggregations
-> Maybe Highlights
-> Bool
-> From
-> Size
-> SearchType
-> Maybe [Value]
-> Maybe [FieldName]
-> Maybe ScriptFields
-> Maybe Source
-> Maybe Suggest
-> Maybe PointInTime
-> Search
Search
    { queryBody :: Maybe Query
queryBody = Maybe Query
query,
      filterBody :: Maybe Filter
filterBody = Maybe Filter
forall a. Maybe a
Nothing,
      sortBody :: Maybe Sort
sortBody = Maybe Sort
forall a. Maybe a
Nothing,
      aggBody :: Maybe Aggregations
aggBody = Maybe Aggregations
forall a. Maybe a
Nothing,
      highlight :: Maybe Highlights
highlight = Highlights -> Maybe Highlights
forall a. a -> Maybe a
Just Highlights
searchHighlights,
      trackSortScores :: Bool
trackSortScores = Bool
False,
      from :: From
from = Int -> From
From Int
0,
      size :: Size
size = Int -> Size
Size Int
10,
      searchType :: SearchType
searchType = SearchType
SearchTypeDfsQueryThenFetch,
      searchAfterKey :: Maybe [Value]
searchAfterKey = Maybe [Value]
forall a. Maybe a
Nothing,
      fields :: Maybe [FieldName]
fields = Maybe [FieldName]
forall a. Maybe a
Nothing,
      scriptFields :: Maybe ScriptFields
scriptFields = Maybe ScriptFields
forall a. Maybe a
Nothing,
      source :: Maybe Source
source = Maybe Source
forall a. Maybe a
Nothing,
      suggestBody :: Maybe Suggest
suggestBody = Maybe Suggest
forall a. Maybe a
Nothing,
      pointInTime :: Maybe PointInTime
pointInTime = Maybe PointInTime
forall a. Maybe a
Nothing
    }

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

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

parseUrl' :: MonadThrow m => Text -> m Request
parseUrl' :: Text -> m Request
parseUrl' Text
t = [Char] -> m Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest ((Char -> Bool) -> 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 :: EsUsername -> EsPassword -> Request -> m Request
basicAuthHook (EsUsername Text
u) (EsPassword Text
p) = Request -> m Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> m Request)
-> (Request -> Request) -> Request -> m Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Method -> Request -> Request
applyBasicAuth Method
u' Method
p'
  where
    u' :: Method
u' = Text -> Method
T.encodeUtf8 Text
u
    p' :: Method
p' = Text -> Method
T.encodeUtf8 Text
p

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

countByIndex :: (MonadBH m, MonadThrow m) => IndexName -> CountQuery -> m (ParsedEsResponse CountResponse)
countByIndex :: IndexName -> CountQuery -> m (ParsedEsResponse CountResponse)
countByIndex (IndexName Text
indexName) CountQuery
q =
  BHResponse CountResponse -> m (ParsedEsResponse CountResponse)
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse (BHResponse CountResponse -> m (ParsedEsResponse CountResponse))
-> m (BHResponse CountResponse)
-> m (ParsedEsResponse CountResponse)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Endpoint -> ByteString -> m (BHResponse CountResponse)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
Item Endpoint
indexName, Item Endpoint
"_count"] (CountQuery -> ByteString
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 :: IndexName -> m (ParsedEsResponse OpenPointInTimeResponse)
openPointInTime (IndexName Text
indexName) =
  BHResponse OpenPointInTimeResponse
-> m (ParsedEsResponse OpenPointInTimeResponse)
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse (BHResponse OpenPointInTimeResponse
 -> m (ParsedEsResponse OpenPointInTimeResponse))
-> m (BHResponse OpenPointInTimeResponse)
-> m (ParsedEsResponse OpenPointInTimeResponse)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Endpoint -> ByteString -> m (BHResponse OpenPointInTimeResponse)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
post [Text
Item Endpoint
indexName, Item Endpoint
"_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 :: ClosePointInTime -> m (ParsedEsResponse ClosePointInTimeResponse)
closePointInTime ClosePointInTime
q = do
  BHResponse ClosePointInTimeResponse
-> m (ParsedEsResponse ClosePointInTimeResponse)
forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse (BHResponse ClosePointInTimeResponse
 -> m (ParsedEsResponse ClosePointInTimeResponse))
-> m (BHResponse ClosePointInTimeResponse)
-> m (ParsedEsResponse ClosePointInTimeResponse)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Endpoint -> ByteString -> m (BHResponse ClosePointInTimeResponse)
forall (m :: * -> *) body.
MonadBH m =>
Endpoint -> ByteString -> m (BHResponse body)
deleteWithBody [Item Endpoint
"_pit"] (ClosePointInTime -> ByteString
forall a. ToJSON a => a -> ByteString
encode ClosePointInTime
q)