{-# 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 : OverloadedStrings
--
-- 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
       -- *** Index Aliases
       , updateIndexAliases
       , getIndexAliases
       , deleteIndexAlias
       -- *** Index Templates
       , putTemplate
       , templateExists
       , deleteTemplate
       -- ** Mapping
       , putMapping
       -- ** Documents
       , indexDocument
       , updateDocument
       , getDocument
       , documentExists
       , deleteDocument
       , deleteByQuery
       -- ** Searching
       , searchAll
       , searchByIndex
       , searchByIndices
       , searchByIndexTemplate
       , searchByIndicesTemplate
       , scanSearch
       , getInitialScroll
       , getInitialSortedScroll
       , advanceScroll
       , 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
       -- * Reply-handling tools
       , isVersionConflict
       , isSuccess
       , isCreated
       , parseEsResponse
       -- * Count
       , countByIndex
       )
       where

import qualified Blaze.ByteString.Builder     as BB
import           Control.Applicative          as A
import           Control.Monad
import           Control.Monad.Catch
import           Control.Monad.IO.Class
import           Data.Aeson
import           Data.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           Data.Ix
import qualified Data.List                    as LS (foldl')
import           Data.List.NonEmpty           (NonEmpty (..))
import           Data.Maybe                   (catMaybes, fromMaybe)
import           Data.Monoid
import           Data.Text                    (Text)
import qualified Data.Text                    as T
import qualified Data.Text.Encoding           as T
import           Data.Time.Clock
import qualified Data.Vector                  as V
import           Network.HTTP.Client
import qualified Network.HTTP.Types.Method    as NHTM
import qualified Network.HTTP.Types.Status    as NHTS
import qualified Network.HTTP.Types.URI       as NHTU
import qualified Network.URI                  as URI
import           Prelude                      hiding (filter, head)

import           Database.Bloodhound.Types

-- $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
         => Method
         -> Text
         -> Maybe L.ByteString
         -> m Reply
dispatch :: Method -> Text -> Maybe ByteString -> m Reply
dispatch Method
dMethod Text
url Maybe ByteString
body = do
  Request
initReq <- IO Request -> m Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> m Request) -> IO Request -> m Request
forall a b. (a -> b) -> a -> b
$ Text -> IO Request
forall (m :: * -> *). MonadThrow m => Text -> m Request
parseUrl' Text
url
  Request -> IO Request
reqHook <- BHEnv -> Request -> IO Request
bhRequestHook (BHEnv -> Request -> IO Request)
-> m BHEnv -> m (Request -> IO Request)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
A.<$> m BHEnv
forall (m :: * -> *). MonadBH m => m BHEnv
getBHEnv
  let reqBody :: RequestBody
reqBody = ByteString -> RequestBody
RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
emptyBody Maybe ByteString
body
  Request
req <- IO Request -> m Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
         (IO Request -> m Request) -> IO Request -> m Request
forall a b. (a -> b) -> a -> b
$ Request -> IO Request
reqHook
         (Request -> IO Request) -> Request -> IO Request
forall a b. (a -> b) -> a -> b
$ Request -> Request
setRequestIgnoreStatus
         (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
initReq { method :: Method
method = Method
dMethod
                   , requestHeaders :: RequestHeaders
requestHeaders =
                     -- "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 }
  Manager
mgr <- BHEnv -> Manager
bhManager (BHEnv -> Manager) -> m BHEnv -> m Manager
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m BHEnv
forall (m :: * -> *). MonadBH m => m BHEnv
getBHEnv
  IO Reply -> m Reply
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Reply -> m Reply) -> IO Reply -> m Reply
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO Reply
httpLbs Request
req Manager
mgr

joinPath' :: [Text] -> Text
joinPath' :: [Text] -> Text
joinPath' = Text -> [Text] -> Text
T.intercalate Text
"/"

joinPath :: MonadBH m => [Text] -> m Text
joinPath :: [Text] -> m Text
joinPath [Text]
ps = do
  Server Text
s <- BHEnv -> Server
bhServer (BHEnv -> Server) -> m BHEnv -> m Server
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m BHEnv
forall (m :: * -> *). MonadBH m => m BHEnv
getBHEnv
  Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
joinPath' (Text
sText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ps)

appendSearchTypeParam :: Text -> SearchType -> Text
appendSearchTypeParam :: Text -> SearchType -> Text
appendSearchTypeParam Text
originalUrl SearchType
st = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params Text
originalUrl
  where stText :: Text
stText = Text
"search_type"
        params :: [(Text, Maybe Text)]
params
          | SearchType
st SearchType -> SearchType -> Bool
forall a. Eq a => a -> a -> Bool
== SearchType
SearchTypeDfsQueryThenFetch = [(Text
stText, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"dfs_query_then_fetch")]
        -- used to catch 'SearchTypeQueryThenFetch', which is also the default
          | Bool
otherwise                         = []

-- | Severely dumbed down query renderer. Assumes your data doesn't
-- need any encoding
addQuery :: [(Text, Maybe Text)] -> Text -> Text
addQuery :: [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
q Text
u = Text
u Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rendered
  where
    rendered :: Text
rendered =
      Method -> Text
T.decodeUtf8 (Method -> Text) -> Method -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Method
BB.toByteString (Builder -> Method) -> Builder -> Method
forall a b. (a -> b) -> a -> b
$ Bool -> [(Text, Maybe Text)] -> Builder
NHTU.renderQueryText Bool
prependQuestionMark [(Text, Maybe Text)]
q
    prependQuestionMark :: Bool
prependQuestionMark = Bool
True

bindM2 :: (Applicative m, Monad m) => (a -> b -> m c) -> m a -> m b -> m c
bindM2 :: (a -> b -> m c) -> m a -> m b -> m c
bindM2 a -> b -> m c
f m a
ma m b
mb = m (m c) -> m c
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (a -> b -> m c
f (a -> b -> m c) -> m a -> m (b -> m c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
ma m (b -> m c) -> m b -> m (m c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m b
mb)

-- | 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 => Text -> m Reply
delete :: Text -> m Reply
delete = (Text -> Maybe ByteString -> m Reply)
-> Maybe ByteString -> Text -> m Reply
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Method -> Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Method -> Text -> Maybe ByteString -> m Reply
dispatch Method
NHTM.methodDelete) Maybe ByteString
forall a. Maybe a
Nothing
get    :: MonadBH m => Text -> m Reply
get :: Text -> m Reply
get    = (Text -> Maybe ByteString -> m Reply)
-> Maybe ByteString -> Text -> m Reply
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Method -> Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Method -> Text -> Maybe ByteString -> m Reply
dispatch Method
NHTM.methodGet) Maybe ByteString
forall a. Maybe a
Nothing
head   :: MonadBH m => Text -> m Reply
head :: Text -> m Reply
head   = (Text -> Maybe ByteString -> m Reply)
-> Maybe ByteString -> Text -> m Reply
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Method -> Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Method -> Text -> Maybe ByteString -> m Reply
dispatch Method
NHTM.methodHead) Maybe ByteString
forall a. Maybe a
Nothing
put    :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
put :: Text -> Maybe ByteString -> m Reply
put    = Method -> Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Method -> Text -> Maybe ByteString -> m Reply
dispatch Method
NHTM.methodPut
post   :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
post :: Text -> Maybe ByteString -> m Reply
post   = Method -> Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Method -> Text -> Maybe ByteString -> m Reply
dispatch Method
NHTM.methodPost

-- indexDocument s ix name doc = put (root </> s </> ix </> name </> doc) (Just encode doc)
-- http://hackage.haskell.org/package/http-client-lens-0.1.0/docs/Network-HTTP-Client-Lens.html
-- https://github.com/supki/libjenkins/blob/master/src/Jenkins/Rest/Internal.hs

-- | 'getStatus' fetches the 'Status' of a 'Server'
--
-- >>> serverStatus <- runBH' getStatus
-- >>> fmap tagline (serverStatus)
-- Just "You Know, for Search"
getStatus :: MonadBH m => m (Maybe Status)
getStatus :: m (Maybe Status)
getStatus = do
  Reply
response <- Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
  Maybe Status -> m (Maybe Status)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Status -> m (Maybe Status))
-> Maybe Status -> m (Maybe Status)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Status
forall a. FromJSON a => ByteString -> Maybe a
decode (Reply -> ByteString
forall body. Response body -> body
responseBody Reply
response)
  where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath []

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


-- | 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
     )
  => SnapshotRepoUpdateSettings
  -- ^ Use 'defaultSnapshotRepoUpdateSettings' if unsure
  -> repo
  -> m Reply
updateSnapshotRepo :: SnapshotRepoUpdateSettings -> repo -> m Reply
updateSnapshotRepo SnapshotRepoUpdateSettings {Bool
repoUpdateVerify :: SnapshotRepoUpdateSettings -> Bool
repoUpdateVerify :: Bool
..} repo
repo =
  (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
body))
  where
    url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_snapshot", SnapshotRepoName -> Text
snapshotRepoName SnapshotRepoName
gSnapshotRepoName]
    params :: [(Text, Maybe Text)]
params
      | Bool
repoUpdateVerify = []
      | Bool
otherwise        = [(Text
"verify", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"false")]
    body :: ByteString
body = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [(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 (Either EsError SnapshotVerification)
verifySnapshotRepo :: SnapshotRepoName -> m (Either EsError SnapshotVerification)
verifySnapshotRepo (SnapshotRepoName Text
n) =
  Reply -> m (Either EsError SnapshotVerification)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError SnapshotVerification))
-> m Reply -> m (Either EsError SnapshotVerification)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing)
  where
    url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_snapshot", Text
n, Text
"_verify"]


deleteSnapshotRepo :: MonadBH m => SnapshotRepoName -> m Reply
deleteSnapshotRepo :: SnapshotRepoName -> m Reply
deleteSnapshotRepo (SnapshotRepoName Text
n) = Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
delete (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
  where
    url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_snapshot", Text
n]


-- | Create and start a snapshot
createSnapshot
    :: (MonadBH m)
    => SnapshotRepoName
    -> SnapshotName
    -> SnapshotCreateSettings
    -> m Reply
createSnapshot :: SnapshotRepoName
-> SnapshotName -> SnapshotCreateSettings -> m Reply
createSnapshot (SnapshotRepoName Text
repoName)
               (SnapshotName Text
snapName)
               SnapshotCreateSettings {Bool
Maybe IndexSelection
snapPartial :: SnapshotCreateSettings -> Bool
snapIncludeGlobalState :: SnapshotCreateSettings -> Bool
snapIgnoreUnavailable :: SnapshotCreateSettings -> Bool
snapIndices :: SnapshotCreateSettings -> Maybe IndexSelection
snapWaitForCompletion :: SnapshotCreateSettings -> Bool
snapPartial :: Bool
snapIncludeGlobalState :: Bool
snapIgnoreUnavailable :: Bool
snapIndices :: Maybe IndexSelection
snapWaitForCompletion :: Bool
..} =
  (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
body))
  where
    url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_snapshot", Text
repoName, Text
snapName]
    params :: [(Text, Maybe Text)]
params = [(Text
"wait_for_completion", Text -> Maybe Text
forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
snapWaitForCompletion))]
    body :: ByteString
body = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [(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
iIndexName -> [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 (Either EsError [SnapshotInfo])
getSnapshots :: SnapshotRepoName
-> SnapshotSelection -> m (Either EsError [SnapshotInfo])
getSnapshots (SnapshotRepoName Text
repoName) SnapshotSelection
sel =
  (Either EsError SIs -> Either EsError [SnapshotInfo])
-> m (Either EsError SIs) -> m (Either EsError [SnapshotInfo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SIs -> [SnapshotInfo])
-> Either EsError SIs -> Either EsError [SnapshotInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SIs -> [SnapshotInfo]
unSIs) (m (Either EsError SIs) -> m (Either EsError [SnapshotInfo]))
-> (Reply -> m (Either EsError SIs))
-> Reply
-> m (Either EsError [SnapshotInfo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply -> m (Either EsError SIs)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError [SnapshotInfo]))
-> m Reply -> m (Either EsError [SnapshotInfo])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
  where
    url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_snapshot", Text
repoName, Text
snapPath]
    snapPath :: Text
snapPath = case SnapshotSelection
sel of
      SnapshotSelection
AllSnapshots -> Text
"_all"
      SnapshotList (SnapshotPattern
s :| [SnapshotPattern]
ss) -> Text -> [Text] -> Text
T.intercalate Text
"," (SnapshotPattern -> Text
renderPath (SnapshotPattern -> Text) -> [SnapshotPattern] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SnapshotPattern
sSnapshotPattern -> [SnapshotPattern] -> [SnapshotPattern]
forall a. a -> [a] -> [a]
:[SnapshotPattern]
ss))
    renderPath :: SnapshotPattern -> Text
renderPath (SnapPattern Text
t)              = Text
t
    renderPath (ExactSnap (SnapshotName Text
t)) = Text
t


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


instance FromJSON SIs where
  parseJSON :: Value -> Parser SIs
parseJSON = [Char] -> (Object -> Parser SIs) -> Value -> Parser SIs
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Collection of SnapshotInfo" Object -> Parser SIs
parse
    where
      parse :: Object -> Parser SIs
parse Object
o = [SnapshotInfo] -> SIs
SIs ([SnapshotInfo] -> SIs) -> Parser [SnapshotInfo] -> Parser SIs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> 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 Reply
deleteSnapshot :: SnapshotRepoName -> SnapshotName -> m Reply
deleteSnapshot (SnapshotRepoName Text
repoName) (SnapshotName Text
snapName) =
  Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
delete (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
  where
    url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_snapshot", Text
repoName, Text
snapName]


-- | 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
    -> SnapshotRestoreSettings
    -- ^ Start with 'defaultSnapshotRestoreSettings' and customize
    -- from there for reasonable defaults.
    -> m Reply
restoreSnapshot :: SnapshotRepoName
-> SnapshotName -> SnapshotRestoreSettings -> m Reply
restoreSnapshot (SnapshotRepoName Text
repoName)
                (SnapshotName Text
snapName)
                SnapshotRestoreSettings {Bool
Maybe (NonEmpty Text)
Maybe (NonEmpty RestoreRenameToken)
Maybe RestoreIndexSettings
Maybe RestoreRenamePattern
Maybe IndexSelection
snapRestoreIgnoreIndexSettings :: SnapshotRestoreSettings -> Maybe (NonEmpty Text)
snapRestoreIndexSettingsOverrides :: SnapshotRestoreSettings -> Maybe RestoreIndexSettings
snapRestoreIncludeAliases :: SnapshotRestoreSettings -> Bool
snapRestorePartial :: SnapshotRestoreSettings -> Bool
snapRestoreRenameReplacement :: SnapshotRestoreSettings -> Maybe (NonEmpty RestoreRenameToken)
snapRestoreRenamePattern :: SnapshotRestoreSettings -> Maybe RestoreRenamePattern
snapRestoreIncludeGlobalState :: SnapshotRestoreSettings -> Bool
snapRestoreIgnoreUnavailable :: SnapshotRestoreSettings -> Bool
snapRestoreIndices :: SnapshotRestoreSettings -> Maybe IndexSelection
snapRestoreWaitForCompletion :: SnapshotRestoreSettings -> Bool
snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
snapRestoreIncludeAliases :: Bool
snapRestorePartial :: Bool
snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
snapRestoreRenamePattern :: Maybe RestoreRenamePattern
snapRestoreIncludeGlobalState :: Bool
snapRestoreIgnoreUnavailable :: Bool
snapRestoreIndices :: Maybe IndexSelection
snapRestoreWaitForCompletion :: Bool
..} = (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
body))
  where
    url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_snapshot", Text
repoName, Text
snapName, Text
"_restore"]
    params :: [(Text, Maybe Text)]
params = [(Text
"wait_for_completion", Text -> Maybe Text
forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
snapRestoreWaitForCompletion))]
    body :: ByteString
body = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([(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
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
tRestoreRenameToken -> [RestoreRenameToken] -> [RestoreRenameToken]
forall a. a -> [a] -> [a]
:[RestoreRenameToken]
ts))
    renderToken :: RestoreRenameToken -> Text
renderToken (RRTLit Text
t)      = Text
t
    renderToken RestoreRenameToken
RRSubWholeMatch = Text
"$0"
    renderToken (RRSubGroup RRGroupRefNum
g)  = [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show (RRGroupRefNum -> Int
rrGroupRefNum RRGroupRefNum
g))


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

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

-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.
--
-- >>> response <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
-- >>> respIsTwoHunna response
-- True
-- >>> runBH' $ indexExists (IndexName "didimakeanindex")
-- True
createIndex :: MonadBH m => IndexSettings -> IndexName -> m Reply
createIndex :: IndexSettings -> IndexName -> m Reply
createIndex IndexSettings
indexSettings (IndexName Text
indexName) =
  (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
  where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName]
        body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ IndexSettings -> ByteString
forall a. ToJSON a => a -> ByteString
encode IndexSettings
indexSettings

-- | 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]
  -> Int -- ^ shard count
  -> IndexName
  -> m Reply
createIndexWith :: [UpdatableIndexSetting] -> Int -> IndexName -> m Reply
createIndexWith [UpdatableIndexSetting]
updates Int
shards (IndexName Text
indexName) =
  (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
body))
  where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName]
        body :: ByteString
body = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [(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 Reply
flushIndex :: IndexName -> m Reply
flushIndex (IndexName Text
indexName) = do
  Text
path <- [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_flush"]
  Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post Text
path Maybe ByteString
forall a. Maybe a
Nothing

-- | 'deleteIndex' will delete an index given a 'Server' and an 'IndexName'.
--
-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
-- >>> respIsTwoHunna response
-- True
-- >>> runBH' $ indexExists (IndexName "didimakeanindex")
-- False
deleteIndex :: MonadBH m => IndexName -> m Reply
deleteIndex :: IndexName -> m Reply
deleteIndex (IndexName Text
indexName) =
  Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
delete (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName]

-- | 'updateIndexSettings' will apply a non-empty list of setting updates to an index
--
-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "unconfiguredindex")
-- >>> response <- runBH' $ updateIndexSettings (BlocksWrite False :| []) (IndexName "unconfiguredindex")
-- >>> respIsTwoHunna response
-- True
updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
updateIndexSettings :: NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
updateIndexSettings NonEmpty UpdatableIndexSetting
updates (IndexName Text
indexName) =
  (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
  where
    url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_settings"]
    body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
jsonBody)
    jsonBody :: Value
jsonBody = Object -> Value
Object ([Object] -> Object
deepMerge [Object
u | Object Object
u <- UpdatableIndexSetting -> Value
forall a. ToJSON a => a -> Value
toJSON (UpdatableIndexSetting -> Value)
-> [UpdatableIndexSetting] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty UpdatableIndexSetting -> [UpdatableIndexSetting]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty UpdatableIndexSetting
updates])


getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
                 -> m (Either EsError IndexSettingsSummary)
getIndexSettings :: IndexName -> m (Either EsError IndexSettingsSummary)
getIndexSettings (IndexName Text
indexName) =
  Reply -> m (Either EsError IndexSettingsSummary)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError IndexSettingsSummary))
-> m Reply -> m (Either EsError IndexSettingsSummary)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
  where
    url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_settings"]

-- | 'forceMergeIndex'
--
-- 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 reply 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 })
-- >>> respIsTwoHunna response
-- True
forceMergeIndex :: MonadBH m => IndexSelection -> ForceMergeIndexSettings -> m Reply
forceMergeIndex :: IndexSelection -> ForceMergeIndexSettings -> m Reply
forceMergeIndex IndexSelection
ixs ForceMergeIndexSettings {Bool
Maybe Int
flushAfterOptimize :: ForceMergeIndexSettings -> Bool
onlyExpungeDeletes :: ForceMergeIndexSettings -> Bool
maxNumSegments :: ForceMergeIndexSettings -> Maybe Int
flushAfterOptimize :: Bool
onlyExpungeDeletes :: Bool
maxNumSegments :: Maybe Int
..} =
    (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
body)
  where url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_forcemerge"]
        params :: [(Text, Maybe Text)]
params = [Maybe (Text, Maybe Text)] -> [(Text, Maybe Text)]
forall a. [Maybe a] -> [a]
catMaybes [ (Text
"max_num_segments",) (Maybe Text -> (Text, Maybe Text))
-> (Int -> Maybe Text) -> Int -> (Text, Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Int -> Text) -> Int -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall a. Show a => a -> Text
showText (Int -> (Text, Maybe Text))
-> Maybe Int -> Maybe (Text, Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maxNumSegments
                           , (Text, Maybe Text) -> Maybe (Text, Maybe Text)
forall a. a -> Maybe a
Just (Text
"only_expunge_deletes", Text -> Maybe Text
forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
onlyExpungeDeletes))
                           , (Text, Maybe Text) -> Maybe (Text, Maybe Text)
forall a. a -> Maybe a
Just (Text
"flush", Text -> Maybe Text
forall a. a -> Maybe a
Just (Bool -> Text
boolQP Bool
flushAfterOptimize))
                           ]
        indexName :: Text
indexName = IndexSelection -> Text
indexSelectionName IndexSelection
ixs
        body :: Maybe a
body = Maybe a
forall a. Maybe a
Nothing


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


statusCodeIs :: (Int, Int) -> Reply -> Bool
statusCodeIs :: (Int, Int) -> Reply -> Bool
statusCodeIs (Int, Int)
r Reply
resp = (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int, Int)
r (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ Status -> Int
NHTS.statusCode (Reply -> Status
forall body. Response body -> Status
responseStatus Reply
resp)

respIsTwoHunna :: Reply -> Bool
respIsTwoHunna :: Reply -> Bool
respIsTwoHunna = (Int, Int) -> Reply -> Bool
statusCodeIs (Int
200, Int
299)

existentialQuery :: MonadBH m => Text -> m (Reply, Bool)
existentialQuery :: Text -> m (Reply, Bool)
existentialQuery Text
url = do
  Reply
reply <- Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
head Text
url
  (Reply, Bool) -> m (Reply, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reply
reply, Reply -> Bool
respIsTwoHunna Reply
reply)


-- | Tries to parse a response body as the expected type @a@ and
-- failing that tries to parse it as an EsError. All well-formed, JSON
-- responses from elasticsearch should fall into these two
-- categories. If they don't, a 'EsProtocolException' will be
-- thrown. If you encounter this, please report the full body it
-- reports along with your Elasticsearch verison.
parseEsResponse :: ( MonadThrow m
                   , FromJSON a
                   )
                => Reply
                -> m (Either EsError a)
parseEsResponse :: Reply -> m (Either EsError a)
parseEsResponse Reply
reply
  | Reply -> Bool
respIsTwoHunna Reply
reply = case ByteString -> Either [Char] a
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
body of
                             Right a
a -> Either EsError a -> m (Either EsError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either EsError a
forall a b. b -> Either a b
Right a
a)
                             Left [Char]
err ->
                               [Char] -> m (Either EsError a)
forall a (m :: * -> *) b.
(FromJSON a, MonadThrow m) =>
[Char] -> m (Either a b)
tryParseError [Char]
err
  | Bool
otherwise = [Char] -> m (Either EsError a)
forall a (m :: * -> *) b.
(FromJSON a, MonadThrow m) =>
[Char] -> m (Either a b)
tryParseError [Char]
"Non-200 status code"
  where body :: ByteString
body = Reply -> ByteString
forall body. Response body -> body
responseBody Reply
reply
        tryParseError :: [Char] -> m (Either a b)
tryParseError [Char]
originalError
          = case ByteString -> Either [Char] a
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
body of
              Right a
e -> Either a b -> m (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either a b
forall a b. a -> Either a b
Left a
e)
              -- Failed to parse the error message.
              Left [Char]
err -> [Char] -> m (Either a b)
forall (m :: * -> *) a. MonadThrow m => [Char] -> m a
explode ([Char]
"Original error was: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
originalError [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" Error parse failure was: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
err)
        explode :: [Char] -> m a
explode [Char]
errorMsg = EsProtocolException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> ByteString -> EsProtocolException
EsProtocolException ([Char] -> Text
T.pack [Char]
errorMsg) ByteString
body)

-- | 'indexExists' 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) = do
  (Reply
_, Bool
exists) <- Text -> m (Reply, Bool)
forall (m :: * -> *). MonadBH m => Text -> m (Reply, Bool)
existentialQuery (Text -> m (Reply, Bool)) -> m Text -> m (Reply, Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName]
  Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exists

-- | 'refreshIndex' 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 Reply
refreshIndex :: IndexName -> m Reply
refreshIndex (IndexName Text
indexName) =
  (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing)
  where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_refresh"]

-- | 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 Reply
waitForYellowIndex :: IndexName -> m Reply
waitForYellowIndex (IndexName Text
indexName) = Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
  where url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
q (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_cluster",Text
"health",Text
indexName]
        q :: [(Text, Maybe Text)]
q = [(Text
"wait_for_status",Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"yellow"),(Text
"timeout",Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"10s")]

stringifyOCIndex :: OpenCloseIndex -> Text
stringifyOCIndex :: OpenCloseIndex -> Text
stringifyOCIndex OpenCloseIndex
oci = case OpenCloseIndex
oci of
  OpenCloseIndex
OpenIndex  -> Text
"_open"
  OpenCloseIndex
CloseIndex -> Text
"_close"

openOrCloseIndexes :: MonadBH m => OpenCloseIndex -> IndexName -> m Reply
openOrCloseIndexes :: OpenCloseIndex -> IndexName -> m Reply
openOrCloseIndexes OpenCloseIndex
oci (IndexName Text
indexName) =
  (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing)
  where ociString :: Text
ociString = OpenCloseIndex -> Text
stringifyOCIndex OpenCloseIndex
oci
        url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
ociString]

-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at
--   <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
--
-- >>> reply <- runBH' $ openIndex testIndex
openIndex :: MonadBH m => IndexName -> m Reply
openIndex :: IndexName -> m Reply
openIndex = OpenCloseIndex -> IndexName -> m Reply
forall (m :: * -> *).
MonadBH m =>
OpenCloseIndex -> IndexName -> m Reply
openOrCloseIndexes OpenCloseIndex
OpenIndex

-- | 'closeIndex' closes an index given a 'Server' and an 'IndexName'. Explained in further detail at
--   <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
--
-- >>> reply <- runBH' $ closeIndex testIndex
closeIndex :: MonadBH m => IndexName -> m Reply
closeIndex :: IndexName -> m Reply
closeIndex = OpenCloseIndex -> IndexName -> m Reply
forall (m :: * -> *).
MonadBH m =>
OpenCloseIndex -> IndexName -> m Reply
openOrCloseIndexes OpenCloseIndex
CloseIndex

-- | 'listIndices' returns a list of all index names on a given 'Server'
listIndices :: (MonadThrow m, MonadBH m) => m [IndexName]
listIndices :: m [IndexName]
listIndices =
  ByteString -> m [IndexName]
forall (m :: * -> *) (t :: * -> *).
(MonadThrow m, FromJSON (t Value), Traversable t) =>
ByteString -> m (t IndexName)
parse (ByteString -> m [IndexName])
-> (Reply -> ByteString) -> Reply -> m [IndexName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply -> ByteString
forall body. Response body -> body
responseBody (Reply -> m [IndexName]) -> m Reply -> m [IndexName]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
  where
    url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_cat/indices?format=json"]
    parse :: ByteString -> m (t IndexName)
parse ByteString
body = ([Char] -> m (t IndexName))
-> (t IndexName -> m (t IndexName))
-> Either [Char] (t IndexName)
-> m (t IndexName)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\[Char]
msg -> (EsProtocolException -> m (t IndexName)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> ByteString -> EsProtocolException
EsProtocolException ([Char] -> Text
T.pack [Char]
msg) ByteString
body))) t IndexName -> m (t IndexName)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] (t IndexName) -> m (t IndexName))
-> Either [Char] (t IndexName) -> m (t IndexName)
forall a b. (a -> b) -> a -> b
$ do
      t Value
vals <- ByteString -> Either [Char] (t Value)
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
body
      t Value
-> (Value -> Either [Char] IndexName)
-> Either [Char] (t IndexName)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM t Value
vals ((Value -> Either [Char] IndexName) -> Either [Char] (t IndexName))
-> (Value -> Either [Char] IndexName)
-> Either [Char] (t IndexName)
forall a b. (a -> b) -> a -> b
$ \Value
val ->
        case Value
val of
          Object Object
obj ->
            case 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] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Maybe Value -> [Char]
forall a. Show a => a -> [Char]
show Maybe Value
v
          Value
v -> [Char] -> Either [Char] IndexName
forall a b. a -> Either a b
Left ([Char] -> Either [Char] IndexName)
-> [Char] -> Either [Char] IndexName
forall a b. (a -> b) -> a -> b
$ [Char]
"One of the values parsed in listIndices wasn't an object, it was: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v

-- | 'catIndices' 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 =
  ByteString -> m [(IndexName, Int)]
forall (m :: * -> *) (t :: * -> *) b.
(MonadThrow m, FromJSON (t Value), Traversable t, Read b) =>
ByteString -> m (t (IndexName, b))
parse (ByteString -> m [(IndexName, Int)])
-> (Reply -> ByteString) -> Reply -> m [(IndexName, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply -> ByteString
forall body. Response body -> body
responseBody (Reply -> m [(IndexName, Int)]) -> m Reply -> m [(IndexName, Int)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
  where
    url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_cat/indices?format=json"]
    parse :: ByteString -> m (t (IndexName, b))
parse ByteString
body = ([Char] -> m (t (IndexName, b)))
-> (t (IndexName, b) -> m (t (IndexName, b)))
-> Either [Char] (t (IndexName, b))
-> m (t (IndexName, b))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\[Char]
msg -> (EsProtocolException -> m (t (IndexName, b))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> ByteString -> EsProtocolException
EsProtocolException ([Char] -> Text
T.pack [Char]
msg) ByteString
body))) t (IndexName, b) -> m (t (IndexName, b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] (t (IndexName, b)) -> m (t (IndexName, b)))
-> Either [Char] (t (IndexName, b)) -> m (t (IndexName, b))
forall a b. (a -> b) -> a -> b
$ do
      t Value
vals <- ByteString -> Either [Char] (t Value)
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
body
      t Value
-> (Value -> Either [Char] (IndexName, b))
-> Either [Char] (t (IndexName, b))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM t Value
vals ((Value -> Either [Char] (IndexName, b))
 -> Either [Char] (t (IndexName, b)))
-> (Value -> Either [Char] (IndexName, b))
-> Either [Char] (t (IndexName, b))
forall a b. (a -> b) -> a -> b
$ \Value
val ->
        case Value
val of
          Object Object
obj ->
            case (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, b) -> Either [Char] (IndexName, b)
forall a b. b -> Either a b
Right ((Text -> IndexName
IndexName Text
txt), [Char] -> b
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
docs))
              (Maybe Value, Maybe Value)
v -> [Char] -> Either [Char] (IndexName, b)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (IndexName, b))
-> [Char] -> Either [Char] (IndexName, b)
forall a b. (a -> b) -> a -> b
$ [Char]
"indexVal in catIndices failed on non-string, was: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Maybe Value, Maybe Value) -> [Char]
forall a. Show a => a -> [Char]
show (Maybe Value, Maybe Value)
v
          Value
v -> [Char] -> Either [Char] (IndexName, b)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (IndexName, b))
-> [Char] -> Either [Char] (IndexName, b)
forall a b. (a -> b) -> a -> b
$ [Char]
"One of the values parsed in catIndices wasn't an object, it was: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v

-- | 'updateIndexAliases' 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
-- >>> respIsTwoHunna <$> runBH' (createIndex defaultIndexSettings src)
-- True
-- >>> runBH' $ indexExists src
-- True
-- >>> respIsTwoHunna <$> runBH' (updateIndexAliases (AddAlias iAlias aliasCreate :| []))
-- True
-- >>> runBH' $ indexExists aliasName
-- True
updateIndexAliases :: MonadBH m => NonEmpty IndexAliasAction -> m Reply
updateIndexAliases :: NonEmpty IndexAliasAction -> m Reply
updateIndexAliases NonEmpty IndexAliasAction
actions = (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
  where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_aliases"]
        body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
bodyJSON)
        bodyJSON :: Value
bodyJSON = [(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 (Either EsError IndexAliasesSummary)
getIndexAliases :: m (Either EsError IndexAliasesSummary)
getIndexAliases = Reply -> m (Either EsError IndexAliasesSummary)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError IndexAliasesSummary))
-> m Reply -> m (Either EsError IndexAliasesSummary)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
  where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_aliases"]

-- | Delete a single alias, removing it from all indices it
--   is currently associated with.
deleteIndexAlias :: MonadBH m => IndexAliasName -> m Reply
deleteIndexAlias :: IndexAliasName -> m Reply
deleteIndexAlias (IndexAliasName (IndexName Text
name)) = Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
delete (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
url
  where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_all",Text
"_alias",Text
name]

-- | 'putTemplate' 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 Reply
putTemplate :: IndexTemplate -> TemplateName -> m Reply
putTemplate IndexTemplate
indexTemplate (TemplateName Text
templateName) =
  (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
  where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_template", Text
templateName]
        body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ IndexTemplate -> ByteString
forall a. ToJSON a => a -> ByteString
encode IndexTemplate
indexTemplate

-- | 'templateExists' 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) = do
  (Reply
_, Bool
exists) <- Text -> m (Reply, Bool)
forall (m :: * -> *). MonadBH m => Text -> m (Reply, Bool)
existentialQuery (Text -> m (Reply, Bool)) -> m Text -> m (Reply, Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_template", Text
templateName]
  Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exists

-- | 'deleteTemplate' 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 Reply
deleteTemplate :: TemplateName -> m Reply
deleteTemplate (TemplateName Text
templateName) =
  Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
delete (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_template", Text
templateName]

-- | 'putMapping' 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 Reply
putMapping :: IndexName -> a -> m Reply
putMapping (IndexName Text
indexName) a
mapping =
  (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
  where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_mapping"]
        -- "_mapping" above is originally transposed
        -- erroneously. The correct API call is: "/INDEX/_mapping"
        body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
mapping

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

-- | 'indexDocument' 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 Reply
indexDocument :: IndexName -> IndexDocumentSettings -> doc -> DocId -> m Reply
indexDocument (IndexName Text
indexName) IndexDocumentSettings
cfg doc
document (DocId Text
docId) =
  (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
put m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
  where url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery (IndexDocumentSettings -> DocId -> [(Text, Maybe Text)]
indexQueryString IndexDocumentSettings
cfg (Text -> DocId
DocId Text
docId)) (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_doc", Text
docId]
        jsonBody :: Value
jsonBody = IndexDocumentSettings -> doc -> Value
forall doc. ToJSON doc => IndexDocumentSettings -> doc -> Value
encodeDocument IndexDocumentSettings
cfg doc
document
        body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
jsonBody)

-- | 'updateDocument' provides a way to perform an partial update of a
-- an already indexed document.
updateDocument :: (ToJSON patch, MonadBH m) => IndexName
                  -> IndexDocumentSettings -> patch -> DocId -> m Reply
updateDocument :: IndexName -> IndexDocumentSettings -> patch -> DocId -> m Reply
updateDocument (IndexName Text
indexName) IndexDocumentSettings
cfg patch
patch (DocId Text
docId) =
  (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
  where url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery (IndexDocumentSettings -> DocId -> [(Text, Maybe Text)]
indexQueryString IndexDocumentSettings
cfg (Text -> DocId
DocId Text
docId)) (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_update", Text
docId]
        jsonBody :: Value
jsonBody = IndexDocumentSettings -> patch -> Value
forall doc. ToJSON doc => IndexDocumentSettings -> doc -> Value
encodeDocument IndexDocumentSettings
cfg patch
patch
        body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Value
object [Key
"doc" Key -> Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
jsonBody])

{-  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 Reply
deleteDocument :: IndexName -> DocId -> m Reply
deleteDocument (IndexName Text
indexName) (DocId Text
docId) =
  Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
delete (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_doc", Text
docId]

-- | 'deleteByQuery' 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 Reply
deleteByQuery :: IndexName -> Query -> m Reply
deleteByQuery (IndexName Text
indexName) Query
query =
  (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
  where
    url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_delete_by_query"]
    body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Value
object [ Key
"query" Key -> Query -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Query
query ])

-- | 'bulk' uses
--    <http://www.elasticsearch.org/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 Reply
bulk :: Vector BulkOperation -> m Reply
bulk Vector BulkOperation
bulkOps =
  (Text -> Maybe ByteString -> m Reply)
-> m Text -> m (Maybe ByteString) -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post m Text
url (Maybe ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
body)
  where
    url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_bulk"]
    body :: Maybe ByteString
body = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Vector BulkOperation -> ByteString
encodeBulkOperations Vector BulkOperation
bulkOps

-- | 'encodeBulkOperations' 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 -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True] else []
                  upsert :: [(Key, Value)]
upsert = [Key
"upsert" Key -> Value -> (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 :: MonadBH m => IndexName -> DocId -> m Reply
getDocument :: IndexName -> DocId -> m Reply
getDocument (IndexName Text
indexName) (DocId Text
docId) =
  Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get (Text -> m Reply) -> m Text -> m Reply
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_doc", Text
docId]

-- | 'documentExists' 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) =
  ((Reply, Bool) -> Bool) -> m (Reply, Bool) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Reply, Bool) -> Bool
forall a b. (a, b) -> b
snd (Text -> m (Reply, Bool)
forall (m :: * -> *). MonadBH m => Text -> m (Reply, Bool)
existentialQuery (Text -> m (Reply, Bool)) -> m Text -> m (Reply, Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_doc", Text
docId])

dispatchSearch :: MonadBH m => Text -> Search -> m Reply
dispatchSearch :: Text -> Search -> m Reply
dispatchSearch Text
url Search
search = Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post Text
url' (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Search -> ByteString
forall a. ToJSON a => a -> ByteString
encode Search
search))
  where url' :: Text
url' = Text -> SearchType -> Text
appendSearchTypeParam Text
url (Search -> SearchType
searchType Search
search)

-- | 'searchAll', 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
-- >>> reply <- runBH' $ searchAll search
searchAll :: MonadBH m => Search -> m Reply
searchAll :: Search -> m Reply
searchAll = (Text -> Search -> m Reply) -> m Text -> m Search -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Search -> m Reply
forall (m :: * -> *). MonadBH m => Text -> Search -> m Reply
dispatchSearch m Text
url (m Search -> m Reply) -> (Search -> m Search) -> Search -> m Reply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Search -> m Search
forall (m :: * -> *) a. Monad m => a -> m a
return
  where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_search"]

-- | 'searchByIndex', 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
-- >>> reply <- runBH' $ searchByIndex testIndex search
searchByIndex :: MonadBH m => IndexName -> Search -> m Reply
searchByIndex :: IndexName -> Search -> m Reply
searchByIndex (IndexName Text
indexName) = (Text -> Search -> m Reply) -> m Text -> m Search -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Search -> m Reply
forall (m :: * -> *). MonadBH m => Text -> Search -> m Reply
dispatchSearch m Text
url (m Search -> m Reply) -> (Search -> m Search) -> Search -> m Reply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Search -> m Search
forall (m :: * -> *) a. Monad m => a -> m a
return
  where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_search"]

-- | 'searchByIndices' 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 Reply
searchByIndices :: NonEmpty IndexName -> Search -> m Reply
searchByIndices NonEmpty IndexName
ixs = (Text -> Search -> m Reply) -> m Text -> m Search -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Search -> m Reply
forall (m :: * -> *). MonadBH m => Text -> Search -> m Reply
dispatchSearch m Text
url (m Search -> m Reply) -> (Search -> m Search) -> Search -> m Reply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Search -> m Search
forall (m :: * -> *) a. Monad m => a -> m a
return
  where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
renderedIxs, Text
"_search"]
        renderedIxs :: Text
renderedIxs = Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
',') ((IndexName -> Text) -> [IndexName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(IndexName Text
t) -> Text
t) (NonEmpty IndexName -> [IndexName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexName
ixs))

dispatchSearchTemplate :: MonadBH m => Text -> SearchTemplate -> m Reply
dispatchSearchTemplate :: Text -> SearchTemplate -> m Reply
dispatchSearchTemplate Text
url SearchTemplate
search = Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post Text
url (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (SearchTemplate -> ByteString
forall a. ToJSON a => a -> ByteString
encode SearchTemplate
search))

-- | 'searchByIndexTemplate', 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
-- >>> reply <- runBH' $ searchByIndexTemplate testIndex search
searchByIndexTemplate :: MonadBH m => IndexName -> SearchTemplate -> m Reply
searchByIndexTemplate :: IndexName -> SearchTemplate -> m Reply
searchByIndexTemplate (IndexName Text
indexName) = (Text -> SearchTemplate -> m Reply)
-> m Text -> m SearchTemplate -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> SearchTemplate -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> SearchTemplate -> m Reply
dispatchSearchTemplate m Text
url (m SearchTemplate -> m Reply)
-> (SearchTemplate -> m SearchTemplate)
-> SearchTemplate
-> m Reply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchTemplate -> m SearchTemplate
forall (m :: * -> *) a. Monad m => a -> m a
return
  where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_search", Text
"template"]

-- | 'searchByIndicesTemplate' 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 :: MonadBH m => NonEmpty IndexName -> SearchTemplate -> m Reply
searchByIndicesTemplate :: NonEmpty IndexName -> SearchTemplate -> m Reply
searchByIndicesTemplate NonEmpty IndexName
ixs = (Text -> SearchTemplate -> m Reply)
-> m Text -> m SearchTemplate -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> SearchTemplate -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> SearchTemplate -> m Reply
dispatchSearchTemplate m Text
url (m SearchTemplate -> m Reply)
-> (SearchTemplate -> m SearchTemplate)
-> SearchTemplate
-> m Reply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchTemplate -> m SearchTemplate
forall (m :: * -> *) a. Monad m => a -> m a
return
  where url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
renderedIxs, Text
"_search", Text
"template"]
        renderedIxs :: Text
renderedIxs = Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
',') ((IndexName -> Text) -> [IndexName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(IndexName Text
t) -> Text
t) (NonEmpty IndexName -> [IndexName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty IndexName
ixs))

-- | 'storeSearchTemplate', saves a 'SearchTemplateSource' to be used later.
storeSearchTemplate :: MonadBH m => SearchTemplateId -> SearchTemplateSource -> m Reply
storeSearchTemplate :: SearchTemplateId -> SearchTemplateSource -> m Reply
storeSearchTemplate (SearchTemplateId Text
tid) SearchTemplateSource
ts =
  m Text
url m Text -> (Text -> m Reply) -> m Reply
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Maybe ByteString -> m Reply)
-> Maybe ByteString -> Text -> m Reply
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
json_))
  where
    url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_scripts", Text
tid]
    json_ :: Value
json_ = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(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 Reply 
getSearchTemplate :: SearchTemplateId -> m Reply
getSearchTemplate (SearchTemplateId Text
tid) =
  m Text
url m Text -> (Text -> m Reply) -> m Reply
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
get
  where
    url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_scripts", Text
tid]

-- | 'storeSearchTemplate', 
deleteSearchTemplate :: MonadBH m => SearchTemplateId -> m Reply 
deleteSearchTemplate :: SearchTemplateId -> m Reply
deleteSearchTemplate (SearchTemplateId Text
tid) =
  m Text
url m Text -> (Text -> m Reply) -> m Reply
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> m Reply
forall (m :: * -> *). MonadBH m => Text -> m Reply
delete
  where
    url :: m Text
url = [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_scripts", Text
tid]

-- | 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 (Either EsError (SearchResult a))
getInitialScroll :: IndexName -> Search -> m (Either EsError (SearchResult a))
getInitialScroll (IndexName Text
indexName) Search
search' = do
    let url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_search"]
        params :: [(Text, Maybe Text)]
params = [(Text
"scroll", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"1m")]
        sorting :: Maybe [SortSpec]
sorting = [SortSpec] -> Maybe [SortSpec]
forall a. a -> Maybe a
Just [DefaultSort -> SortSpec
DefaultSortSpec (DefaultSort -> SortSpec) -> DefaultSort -> SortSpec
forall a b. (a -> b) -> a -> b
$ FieldName -> SortOrder -> DefaultSort
mkSort (Text -> FieldName
FieldName Text
"_doc") SortOrder
Descending]
        search :: Search
search = Search
search' { sortBody :: Maybe [SortSpec]
sortBody = Maybe [SortSpec]
sorting }
    Reply
resp' <- (Text -> Search -> m Reply) -> m Text -> m Search -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Search -> m Reply
forall (m :: * -> *). MonadBH m => Text -> Search -> m Reply
dispatchSearch m Text
url (Search -> m Search
forall (m :: * -> *) a. Monad m => a -> m a
return Search
search)
    Reply -> m (Either EsError (SearchResult a))
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse Reply
resp'

-- | 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 (Either EsError (SearchResult a))
getInitialSortedScroll :: IndexName -> Search -> m (Either EsError (SearchResult a))
getInitialSortedScroll (IndexName Text
indexName) Search
search = do
    let url :: m Text
url = [(Text, Maybe Text)] -> Text -> Text
addQuery [(Text, Maybe Text)]
params (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_search"]
        params :: [(Text, Maybe Text)]
params = [(Text
"scroll", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"1m")]
    Reply
resp' <- (Text -> Search -> m Reply) -> m Text -> m Search -> m Reply
forall (m :: * -> *) a b c.
(Applicative m, Monad m) =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Text -> Search -> m Reply
forall (m :: * -> *). MonadBH m => Text -> Search -> m Reply
dispatchSearch m Text
url (Search -> m Search
forall (m :: * -> *) a. Monad m => a -> m a
return Search
search)
    Reply -> m (Either EsError (SearchResult a))
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse Reply
resp'

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

-- | 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
  -> NominalDiffTime
  -- ^ 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.
  -> m (Either EsError (SearchResult a))
advanceScroll :: ScrollId -> NominalDiffTime -> m (Either EsError (SearchResult a))
advanceScroll (ScrollId Text
sid) NominalDiffTime
scroll = do
  Text
url <- [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
"_search", Text
"scroll"]
  Reply
resp <- Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post Text
url (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
scrollObject)
  Reply -> m (Either EsError (SearchResult a))
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse Reply
resp
  where scrollTime :: Text
scrollTime = Integer -> Text
forall a. Show a => a -> Text
showText Integer
secs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"s"
        secs :: Integer
        secs :: Integer
secs = NominalDiffTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round NominalDiffTime
scroll

        scrollObject :: Value
scrollObject = [(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
                              ]

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

-- | 'scanSearch' 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
    Either EsError (SearchResult a)
initialSearchResult <- IndexName -> Search -> m (Either EsError (SearchResult a))
forall a (m :: * -> *).
(FromJSON a, MonadThrow m, MonadBH m) =>
IndexName -> Search -> m (Either EsError (SearchResult a))
getInitialScroll IndexName
indexName Search
search
    let ([Hit a]
hits', Maybe ScrollId
josh) = case Either EsError (SearchResult a)
initialSearchResult of
                          Right SearchResult {Bool
Int
Maybe AggregationResults
Maybe NamedSuggestionResponse
Maybe ScrollId
ShardResult
SearchHits a
suggest :: Maybe NamedSuggestionResponse
scrollId :: Maybe ScrollId
aggregations :: Maybe AggregationResults
searchHits :: SearchHits a
shards :: ShardResult
timedOut :: Bool
took :: Int
suggest :: forall a. SearchResult a -> Maybe NamedSuggestionResponse
scrollId :: forall a. SearchResult a -> Maybe ScrollId
aggregations :: forall a. SearchResult a -> Maybe AggregationResults
searchHits :: forall a. SearchResult a -> SearchHits a
shards :: forall a. SearchResult a -> ShardResult
timedOut :: forall a. SearchResult a -> Bool
took :: forall a. SearchResult a -> Int
..} -> (SearchHits a -> [Hit a]
forall a. SearchHits a -> [Hit a]
hits SearchHits a
searchHits, Maybe ScrollId
scrollId)
                          Left EsError
_ -> ([], Maybe ScrollId
forall a. Maybe a
Nothing)
    ([Hit a]
totalHits, Maybe ScrollId
_) <- [Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
forall a (m :: * -> *).
(FromJSON a, MonadBH m, MonadThrow m) =>
[Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
simpleAccumulator [] ([Hit a]
hits', Maybe ScrollId
josh)
    [Hit a] -> m [Hit a]
forall (m :: * -> *) a. Monad m => a -> m a
return [Hit a]
totalHits

-- | 'mkSearch' 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 = Maybe Query
-> Maybe Filter
-> Maybe [SortSpec]
-> Maybe Aggregations
-> Maybe Highlights
-> Bool
-> From
-> Size
-> SearchType
-> Maybe [Value]
-> Maybe [FieldName]
-> Maybe ScriptFields
-> Maybe Source
-> Maybe Suggest
-> Search
Search Maybe Query
query Maybe Filter
filter Maybe [SortSpec]
forall a. Maybe a
Nothing Maybe Aggregations
forall a. Maybe a
Nothing Maybe Highlights
forall a. Maybe a
Nothing Bool
False (Int -> From
From Int
0) (Int -> Size
Size Int
10) SearchType
SearchTypeQueryThenFetch Maybe [Value]
forall a. Maybe a
Nothing Maybe [FieldName]
forall a. Maybe a
Nothing Maybe ScriptFields
forall a. Maybe a
Nothing Maybe Source
forall a. Maybe a
Nothing Maybe Suggest
forall a. Maybe a
Nothing

-- | 'mkAggregateSearch' 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 = Maybe Query
-> Maybe Filter
-> Maybe [SortSpec]
-> Maybe Aggregations
-> Maybe Highlights
-> Bool
-> From
-> Size
-> SearchType
-> Maybe [Value]
-> Maybe [FieldName]
-> Maybe ScriptFields
-> Maybe Source
-> Maybe Suggest
-> Search
Search Maybe Query
query Maybe Filter
forall a. Maybe a
Nothing Maybe [SortSpec]
forall a. Maybe a
Nothing (Aggregations -> Maybe Aggregations
forall a. a -> Maybe a
Just Aggregations
mkSearchAggs) Maybe Highlights
forall a. Maybe a
Nothing Bool
False (Int -> From
From Int
0) (Int -> Size
Size Int
0) SearchType
SearchTypeQueryThenFetch Maybe [Value]
forall a. Maybe a
Nothing Maybe [FieldName]
forall a. Maybe a
Nothing Maybe ScriptFields
forall a. Maybe a
Nothing Maybe Source
forall a. Maybe a
Nothing Maybe Suggest
forall a. Maybe a
Nothing

-- | 'mkHighlightSearch' 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 = Maybe Query
-> Maybe Filter
-> Maybe [SortSpec]
-> Maybe Aggregations
-> Maybe Highlights
-> Bool
-> From
-> Size
-> SearchType
-> Maybe [Value]
-> Maybe [FieldName]
-> Maybe ScriptFields
-> Maybe Source
-> Maybe Suggest
-> Search
Search Maybe Query
query Maybe Filter
forall a. Maybe a
Nothing Maybe [SortSpec]
forall a. Maybe a
Nothing Maybe Aggregations
forall a. Maybe a
Nothing (Highlights -> Maybe Highlights
forall a. a -> Maybe a
Just Highlights
searchHighlights) Bool
False (Int -> From
From Int
0) (Int -> Size
Size Int
10) SearchType
SearchTypeQueryThenFetch Maybe [Value]
forall a. Maybe a
Nothing Maybe [FieldName]
forall a. Maybe a
Nothing Maybe ScriptFields
forall a. Maybe a
Nothing Maybe Source
forall a. Maybe a
Nothing Maybe Suggest
forall a. Maybe a
Nothing

-- | 'mkSearchTemplate' 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 :: From     -- ^ The result offset
           -> Size     -- ^ The number of results to return
           -> Search  -- ^ The current seach
           -> Search  -- ^ The paged search
pageSearch :: From -> Size -> Search -> Search
pageSearch From
resultOffset Size
pageSize Search
search = Search
search { from :: From
from = From
resultOffset, size :: Size
size = Size
pageSize }

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

-- | Was there an optimistic concurrency control conflict when
-- indexing a document?
isVersionConflict :: Reply -> Bool
isVersionConflict :: Reply -> Bool
isVersionConflict = (Int -> Bool) -> Reply -> Bool
statusCheck (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
409)

isSuccess :: Reply -> Bool
isSuccess :: Reply -> Bool
isSuccess = (Int -> Bool) -> Reply -> Bool
statusCheck ((Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
200, Int
299))

isCreated :: Reply -> Bool
isCreated :: Reply -> Bool
isCreated = (Int -> Bool) -> Reply -> Bool
statusCheck (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
201)

statusCheck :: (Int -> Bool) -> Reply -> Bool
statusCheck :: (Int -> Bool) -> Reply -> Bool
statusCheck Int -> Bool
prd = Int -> Bool
prd (Int -> Bool) -> (Reply -> Int) -> Reply -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Int
NHTS.statusCode (Status -> Int) -> (Reply -> Status) -> Reply -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply -> Status
forall body. Response body -> Status
responseStatus

-- | 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 (Either EsError CountResponse)
countByIndex :: IndexName -> CountQuery -> m (Either EsError CountResponse)
countByIndex (IndexName Text
indexName) CountQuery
q = do
  Text
url <- [Text] -> m Text
forall (m :: * -> *). MonadBH m => [Text] -> m Text
joinPath [Text
indexName, Text
"_count"]
  Reply -> m (Either EsError CountResponse)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
parseEsResponse (Reply -> m (Either EsError CountResponse))
-> m Reply -> m (Either EsError CountResponse)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Maybe ByteString -> m Reply
forall (m :: * -> *).
MonadBH m =>
Text -> Maybe ByteString -> m Reply
post Text
url (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (CountQuery -> ByteString
forall a. ToJSON a => a -> ByteString
encode CountQuery
q))