{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module : Database.Bloodhound.Client
-- Copyright : (C) 2014, 2018 Chris Allen
-- License : BSD-style (see the file LICENSE)
-- Maintainer : Gautier DI FOLCO <gautier.difolco@gmail.com>
-- Stability : provisional
-- Portability : GHC
--
-- Client side abstractions to interact with Elasticsearch servers.
module Database.Bloodhound.Internal.Client.BHRequest
  ( -- * Request
    BHRequest (..),
    mkFullRequest,
    mkSimpleRequest,
    Server (..),
    Endpoint (..),
    mkEndpoint,
    withQueries,
    getEndpoint,

    -- * Response
    BHResponse (..),

    -- * Response interpretation
    ParsedEsResponse,
    decodeResponse,
    eitherDecodeResponse,
    parseEsResponse,
    parseEsResponseWith,
    isVersionConflict,
    isSuccess,
    isCreated,
    statusCodeIs,

    -- * Response handling
    EsProtocolException (..),
    EsResult (..),
    EsResultFound (..),
    EsError (..),

    -- * Common results
    Acknowledged (..),
    Accepted (..),
  )
where

import qualified Blaze.ByteString.Builder as BB
import Control.Applicative as A
import Control.Monad
import Control.Monad.Catch
import Data.Aeson
import qualified Data.ByteString.Lazy as BL
import Data.Ix
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Database.Bloodhound.Internal.Client.Doc
import GHC.Exts
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 Prelude hiding (filter, head)

-- | 'Server' is used with the client functions to point at the ES instance
newtype Server = Server Text
  deriving stock (Server -> Server -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Server -> Server -> Bool
$c/= :: Server -> Server -> Bool
== :: Server -> Server -> Bool
$c== :: Server -> Server -> Bool
Eq, Int -> Server -> ShowS
[Server] -> ShowS
Server -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Server] -> ShowS
$cshowList :: [Server] -> ShowS
show :: Server -> String
$cshow :: Server -> String
showsPrec :: Int -> Server -> ShowS
$cshowsPrec :: Int -> Server -> ShowS
Show)
  deriving newtype (Value -> Parser [Server]
Value -> Parser Server
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Server]
$cparseJSONList :: Value -> Parser [Server]
parseJSON :: Value -> Parser Server
$cparseJSON :: Value -> Parser Server
FromJSON)

-- | 'Endpoint' represents an url before being built
data Endpoint = Endpoint
  { Endpoint -> [Text]
getRawEndpoint :: [Text],
    Endpoint -> [(Text, Maybe Text)]
getRawEndpointQueries :: [(Text, Maybe Text)]
  }
  deriving stock (Endpoint -> Endpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Endpoint -> Endpoint -> Bool
$c/= :: Endpoint -> Endpoint -> Bool
== :: Endpoint -> Endpoint -> Bool
$c== :: Endpoint -> Endpoint -> Bool
Eq, Int -> Endpoint -> ShowS
[Endpoint] -> ShowS
Endpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Endpoint] -> ShowS
$cshowList :: [Endpoint] -> ShowS
show :: Endpoint -> String
$cshow :: Endpoint -> String
showsPrec :: Int -> Endpoint -> ShowS
$cshowsPrec :: Int -> Endpoint -> ShowS
Show)

instance IsList Endpoint where
  type Item Endpoint = Text
  toList :: Endpoint -> [Item Endpoint]
toList = Endpoint -> [Text]
getRawEndpoint
  fromList :: [Item Endpoint] -> Endpoint
fromList = [Text] -> Endpoint
mkEndpoint

-- | Create an 'Endpoint' from a list of url parts
mkEndpoint :: [Text] -> Endpoint
mkEndpoint :: [Text] -> Endpoint
mkEndpoint [Text]
urlParts = [Text] -> [(Text, Maybe Text)] -> Endpoint
Endpoint [Text]
urlParts forall a. Monoid a => a
mempty

-- | Generate the raw URL
getEndpoint :: Server -> Endpoint -> Text
getEndpoint :: Server -> Endpoint -> Text
getEndpoint (Server Text
serverRoot) Endpoint
endpoint =
  Text -> [Text] -> Text
T.intercalate Text
"/" (Text
serverRoot forall a. a -> [a] -> [a]
: Endpoint -> [Text]
getRawEndpoint Endpoint
endpoint) forall a. Semigroup a => a -> a -> a
<> Text
queries
  where
    queries :: Text
queries = ByteString -> Text
T.decodeUtf8 forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toByteString forall a b. (a -> b) -> a -> b
$ Bool -> [(Text, Maybe Text)] -> Builder
NHTU.renderQueryText Bool
prependQuestionMark forall a b. (a -> b) -> a -> b
$ Endpoint -> [(Text, Maybe Text)]
getRawEndpointQueries Endpoint
endpoint
    prependQuestionMark :: Bool
prependQuestionMark = Bool
True

-- | Severely dumbed down query renderer. Assumes your data doesn't
-- need any encoding
withQueries :: Endpoint -> [(Text, Maybe Text)] -> Endpoint
withQueries :: Endpoint -> [(Text, Maybe Text)] -> Endpoint
withQueries Endpoint
endpoint [(Text, Maybe Text)]
queries = Endpoint
endpoint {getRawEndpointQueries :: [(Text, Maybe Text)]
getRawEndpointQueries = Endpoint -> [(Text, Maybe Text)]
getRawEndpointQueries Endpoint
endpoint forall a. Semigroup a => a -> a -> a
<> [(Text, Maybe Text)]
queries}

-- | 'Request' upon Elasticsearch's server.
--
-- @responseBody@ is a phantom type for the expected result
data BHRequest responseBody = BHRequest
  { forall responseBody. BHRequest responseBody -> ByteString
bhRequestMethod :: NHTM.Method,
    forall responseBody. BHRequest responseBody -> Endpoint
bhRequestEndpoint :: Endpoint,
    forall responseBody. BHRequest responseBody -> Maybe ByteString
bhRequestBody :: Maybe BL.ByteString
  }
  deriving stock (BHRequest responseBody -> BHRequest responseBody -> Bool
forall responseBody.
BHRequest responseBody -> BHRequest responseBody -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BHRequest responseBody -> BHRequest responseBody -> Bool
$c/= :: forall responseBody.
BHRequest responseBody -> BHRequest responseBody -> Bool
== :: BHRequest responseBody -> BHRequest responseBody -> Bool
$c== :: forall responseBody.
BHRequest responseBody -> BHRequest responseBody -> Bool
Eq, Int -> BHRequest responseBody -> ShowS
forall responseBody. Int -> BHRequest responseBody -> ShowS
forall responseBody. [BHRequest responseBody] -> ShowS
forall responseBody. BHRequest responseBody -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BHRequest responseBody] -> ShowS
$cshowList :: forall responseBody. [BHRequest responseBody] -> ShowS
show :: BHRequest responseBody -> String
$cshow :: forall responseBody. BHRequest responseBody -> String
showsPrec :: Int -> BHRequest responseBody -> ShowS
$cshowsPrec :: forall responseBody. Int -> BHRequest responseBody -> ShowS
Show)

-- | 'BHRequest' with a body
mkFullRequest :: NHTM.Method -> Endpoint -> BL.ByteString -> BHRequest body
mkFullRequest :: forall body. ByteString -> Endpoint -> ByteString -> BHRequest body
mkFullRequest ByteString
method' Endpoint
endpoint ByteString
body =
  BHRequest
    { bhRequestMethod :: ByteString
bhRequestMethod = ByteString
method',
      bhRequestEndpoint :: Endpoint
bhRequestEndpoint = Endpoint
endpoint,
      bhRequestBody :: Maybe ByteString
bhRequestBody = forall a. a -> Maybe a
Just ByteString
body
    }

-- | 'BHRequest' without a body
mkSimpleRequest :: NHTM.Method -> Endpoint -> BHRequest body
mkSimpleRequest :: forall body. ByteString -> Endpoint -> BHRequest body
mkSimpleRequest ByteString
method' Endpoint
endpoint =
  BHRequest
    { bhRequestMethod :: ByteString
bhRequestMethod = ByteString
method',
      bhRequestEndpoint :: Endpoint
bhRequestEndpoint = Endpoint
endpoint,
      bhRequestBody :: Maybe ByteString
bhRequestBody = forall a. Maybe a
Nothing
    }

-- | Result of a 'BHRequest'
newtype BHResponse body = BHResponse {forall body. BHResponse body -> Response ByteString
getResponse :: Network.HTTP.Client.Response BL.ByteString}
  deriving stock (Int -> BHResponse body -> ShowS
forall body. Int -> BHResponse body -> ShowS
forall body. [BHResponse body] -> ShowS
forall body. BHResponse body -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BHResponse body] -> ShowS
$cshowList :: forall body. [BHResponse body] -> ShowS
show :: BHResponse body -> String
$cshow :: forall body. BHResponse body -> String
showsPrec :: Int -> BHResponse body -> ShowS
$cshowsPrec :: forall body. Int -> BHResponse body -> ShowS
Show)

-- | Result of a 'parseEsResponse'
type ParsedEsResponse a = Either EsError a

-- | Tries to parse a response body as the expected type @body@ 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 version.
parseEsResponse ::
  ( MonadThrow m,
    FromJSON body
  ) =>
  BHResponse body ->
  m (ParsedEsResponse body)
parseEsResponse :: forall (m :: * -> *) body.
(MonadThrow m, FromJSON body) =>
BHResponse body -> m (ParsedEsResponse body)
parseEsResponse BHResponse body
response
  | forall a. BHResponse a -> Bool
isSuccess BHResponse body
response = case forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
      Right body
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right body
a)
      Left String
err ->
        String -> m (ParsedEsResponse body)
tryParseError String
err
  | Bool
otherwise = String -> m (ParsedEsResponse body)
tryParseError String
"Non-200 status code"
  where
    body :: ByteString
body = forall body. Response body -> body
responseBody forall a b. (a -> b) -> a -> b
$ forall body. BHResponse body -> Response ByteString
getResponse BHResponse body
response
    tryParseError :: String -> m (ParsedEsResponse body)
tryParseError String
originalError =
      case forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
        Right EsError
e -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left EsError
e)
        -- Failed to parse the error message.
        Left String
err -> String -> m (ParsedEsResponse body)
explode (String
"Original error was: " forall a. Semigroup a => a -> a -> a
<> String
originalError forall a. Semigroup a => a -> a -> a
<> String
" Error parse failure was: " forall a. Semigroup a => a -> a -> a
<> String
err)
    explode :: String -> m (ParsedEsResponse body)
explode String
errorMsg = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> ByteString -> EsProtocolException
EsProtocolException (String -> Text
T.pack String
errorMsg) ByteString
body

-- | Parse 'BHResponse' with an arbitrary parser
parseEsResponseWith ::
  ( MonadThrow m,
    FromJSON body
  ) =>
  (body -> Either String parsed) ->
  BHResponse body ->
  m parsed
parseEsResponseWith :: forall (m :: * -> *) body parsed.
(MonadThrow m, FromJSON body) =>
(body -> Either String parsed) -> BHResponse body -> m parsed
parseEsResponseWith body -> Either String parsed
parser BHResponse body
response =
  case forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
    Left String
e -> String -> m parsed
explode String
e
    Right body
parsed ->
      case body -> Either String parsed
parser body
parsed of
        Right parsed
a -> forall (m :: * -> *) a. Monad m => a -> m a
return parsed
a
        Left String
e -> String -> m parsed
explode String
e
  where
    body :: ByteString
body = forall body. Response body -> body
responseBody forall a b. (a -> b) -> a -> b
$ forall body. BHResponse body -> Response ByteString
getResponse BHResponse body
response
    explode :: String -> m parsed
explode String
errorMsg = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> ByteString -> EsProtocolException
EsProtocolException (String -> Text
T.pack String
errorMsg) ByteString
body

-- | Helper around 'aeson' 'decode'
decodeResponse ::
  FromJSON a =>
  BHResponse a ->
  Maybe a
decodeResponse :: forall a. FromJSON a => BHResponse a -> Maybe a
decodeResponse = forall a. FromJSON a => ByteString -> Maybe a
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> body
responseBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. BHResponse body -> Response ByteString
getResponse

-- | Helper around 'aeson' 'eitherDecode'
eitherDecodeResponse ::
  FromJSON a =>
  BHResponse a ->
  Either String a
eitherDecodeResponse :: forall a. FromJSON a => BHResponse a -> Either String a
eitherDecodeResponse = forall a. FromJSON a => ByteString -> Either String a
eitherDecode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> body
responseBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. BHResponse body -> Response ByteString
getResponse

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

-- | Check '2xx' status codes
isSuccess :: BHResponse a -> Bool
isSuccess :: forall a. BHResponse a -> Bool
isSuccess = forall body. (Int, Int) -> BHResponse body -> Bool
statusCodeIs (Int
200, Int
299)

-- | Check '201' status code
isCreated :: BHResponse a -> Bool
isCreated :: forall a. BHResponse a -> Bool
isCreated = forall a. (Int -> Bool) -> BHResponse a -> Bool
statusCheck (forall a. Eq a => a -> a -> Bool
== Int
201)

-- | Check status code
statusCheck :: (Int -> Bool) -> BHResponse a -> Bool
statusCheck :: forall a. (Int -> Bool) -> BHResponse a -> Bool
statusCheck Int -> Bool
prd = Int -> Bool
prd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Int
NHTS.statusCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> Status
responseStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. BHResponse body -> Response ByteString
getResponse

-- | Check status code in range
statusCodeIs :: (Int, Int) -> BHResponse body -> Bool
statusCodeIs :: forall body. (Int, Int) -> BHResponse body -> Bool
statusCodeIs (Int, Int)
r BHResponse body
resp = forall a. Ix a => (a, a) -> a -> Bool
inRange (Int, Int)
r forall a b. (a -> b) -> a -> b
$ Status -> Int
NHTS.statusCode (forall body. Response body -> Status
responseStatus forall a b. (a -> b) -> a -> b
$ forall body. BHResponse body -> Response ByteString
getResponse BHResponse body
resp)

-- | 'EsResult' describes the standard wrapper JSON document that you see in
--    successful Elasticsearch lookups or lookups that couldn't find the document.
data EsResult a = EsResult
  { forall a. EsResult a -> Text
_index :: Text,
    forall a. EsResult a -> Text
_type :: Text,
    forall a. EsResult a -> Text
_id :: Text,
    forall a. EsResult a -> Maybe (EsResultFound a)
foundResult :: Maybe (EsResultFound a)
  }
  deriving (EsResult a -> EsResult a -> Bool
forall a. Eq a => EsResult a -> EsResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EsResult a -> EsResult a -> Bool
$c/= :: forall a. Eq a => EsResult a -> EsResult a -> Bool
== :: EsResult a -> EsResult a -> Bool
$c== :: forall a. Eq a => EsResult a -> EsResult a -> Bool
Eq, Int -> EsResult a -> ShowS
forall a. Show a => Int -> EsResult a -> ShowS
forall a. Show a => [EsResult a] -> ShowS
forall a. Show a => EsResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EsResult a] -> ShowS
$cshowList :: forall a. Show a => [EsResult a] -> ShowS
show :: EsResult a -> String
$cshow :: forall a. Show a => EsResult a -> String
showsPrec :: Int -> EsResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> EsResult a -> ShowS
Show)

-- | 'EsResultFound' contains the document and its metadata inside of an
--    'EsResult' when the document was successfully found.
data EsResultFound a = EsResultFound
  { forall a. EsResultFound a -> DocVersion
_version :: DocVersion,
    forall a. EsResultFound a -> a
_source :: a
  }
  deriving (EsResultFound a -> EsResultFound a -> Bool
forall a. Eq a => EsResultFound a -> EsResultFound a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EsResultFound a -> EsResultFound a -> Bool
$c/= :: forall a. Eq a => EsResultFound a -> EsResultFound a -> Bool
== :: EsResultFound a -> EsResultFound a -> Bool
$c== :: forall a. Eq a => EsResultFound a -> EsResultFound a -> Bool
Eq, Int -> EsResultFound a -> ShowS
forall a. Show a => Int -> EsResultFound a -> ShowS
forall a. Show a => [EsResultFound a] -> ShowS
forall a. Show a => EsResultFound a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EsResultFound a] -> ShowS
$cshowList :: forall a. Show a => [EsResultFound a] -> ShowS
show :: EsResultFound a -> String
$cshow :: forall a. Show a => EsResultFound a -> String
showsPrec :: Int -> EsResultFound a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> EsResultFound a -> ShowS
Show)

instance (FromJSON a) => FromJSON (EsResult a) where
  parseJSON :: Value -> Parser (EsResult a)
parseJSON jsonVal :: Value
jsonVal@(Object Object
v) = do
    Bool
found <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"found" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Maybe (EsResultFound a)
fr <-
      if Bool
found
        then forall a. FromJSON a => Value -> Parser a
parseJSON Value
jsonVal
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    forall a.
Text -> Text -> Text -> Maybe (EsResultFound a) -> EsResult a
EsResult
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_index"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_type"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (EsResultFound a)
fr
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

instance (FromJSON a) => FromJSON (EsResultFound a) where
  parseJSON :: Value -> Parser (EsResultFound a)
parseJSON (Object Object
v) =
    forall a. DocVersion -> a -> EsResultFound a
EsResultFound
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_version"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_source"
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

-- | 'EsError' is the generic type that will be returned when there was a
--    problem. If you can't parse the expected response, its a good idea to
--    try parsing this.
data EsError = EsError
  { EsError -> Int
errorStatus :: Int,
    EsError -> Text
errorMessage :: Text
  }
  deriving (EsError -> EsError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EsError -> EsError -> Bool
$c/= :: EsError -> EsError -> Bool
== :: EsError -> EsError -> Bool
$c== :: EsError -> EsError -> Bool
Eq, Int -> EsError -> ShowS
[EsError] -> ShowS
EsError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EsError] -> ShowS
$cshowList :: [EsError] -> ShowS
show :: EsError -> String
$cshow :: EsError -> String
showsPrec :: Int -> EsError -> ShowS
$cshowsPrec :: Int -> EsError -> ShowS
Show)

instance FromJSON EsError where
  parseJSON :: Value -> Parser EsError
parseJSON (Object Object
v) =
    Int -> Text -> EsError
EsError
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reason")))
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

-- | 'EsProtocolException' will be thrown if Bloodhound cannot parse a response
-- returned by the Elasticsearch server. If you encounter this error, please
-- verify that your domain data types and FromJSON instances are working properly
-- (for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're
-- sure that your mappings are correct, then this error may be an indication of an
-- incompatibility between Bloodhound and Elasticsearch. Please open a bug report
-- and be sure to include the exception body.
data EsProtocolException = EsProtocolException
  { EsProtocolException -> Text
esProtoExMessage :: !Text,
    EsProtocolException -> ByteString
esProtoExResponse :: !BL.ByteString
  }
  deriving (EsProtocolException -> EsProtocolException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EsProtocolException -> EsProtocolException -> Bool
$c/= :: EsProtocolException -> EsProtocolException -> Bool
== :: EsProtocolException -> EsProtocolException -> Bool
$c== :: EsProtocolException -> EsProtocolException -> Bool
Eq, Int -> EsProtocolException -> ShowS
[EsProtocolException] -> ShowS
EsProtocolException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EsProtocolException] -> ShowS
$cshowList :: [EsProtocolException] -> ShowS
show :: EsProtocolException -> String
$cshow :: EsProtocolException -> String
showsPrec :: Int -> EsProtocolException -> ShowS
$cshowsPrec :: Int -> EsProtocolException -> ShowS
Show)

instance Exception EsProtocolException

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

instance FromJSON Acknowledged where
  parseJSON :: Value -> Parser Acknowledged
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Acknowledged" forall a b. (a -> b) -> a -> b
$
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Acknowledged
Acknowledged forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"acknowledged")

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

instance FromJSON Accepted where
  parseJSON :: Value -> Parser Accepted
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Accepted" forall a b. (a -> b) -> a -> b
$
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Accepted
Accepted forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"accepted")