module Log.Backend.ElasticSearch
( ElasticSearchConfig
, esServer
, esIndex
, esShardCount
, esReplicaCount
, esMapping
, esLogin
, esLoginInsecure
, checkElasticSearchLogin
, checkElasticSearchConnection
, defaultElasticSearchConfig
, withElasticSearchLogger
, elasticSearchLogger
) where
import Control.Applicative
import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Aeson
import Data.Aeson.Encode.Pretty
import Data.IORef
import Data.Maybe
import Data.Semigroup
import Data.Time
import Log
import Log.Internal.Logger
import Network.HTTP.Client
import Prelude
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as T
import qualified Data.Traversable as F
import qualified Data.Vector as V
import Log.Backend.ElasticSearch.Internal
import qualified Log.Internal.Aeson.Compat as AC
withElasticSearchLogger :: ElasticSearchConfig -> (Logger -> IO r) -> IO r
withElasticSearchLogger :: ElasticSearchConfig -> (Logger -> IO r) -> IO r
withElasticSearchLogger ElasticSearchConfig
conf Logger -> IO r
act = do
Logger
logger <- ElasticSearchConfig -> IO Logger
elasticSearchLogger ElasticSearchConfig
conf
Logger -> (Logger -> IO r) -> IO r
forall r. Logger -> (Logger -> IO r) -> IO r
withLogger Logger
logger Logger -> IO r
act
{-# DEPRECATED elasticSearchLogger "Use 'withElasticSearchLogger' instead!" #-}
elasticSearchLogger
:: ElasticSearchConfig
-> IO Logger
elasticSearchLogger :: ElasticSearchConfig -> IO Logger
elasticSearchLogger esConf :: ElasticSearchConfig
esConf@ElasticSearchConfig{Bool
Int
Maybe (Text, Text)
Text
esLoginInsecure :: Bool
esLogin :: Maybe (Text, Text)
esMapping :: Text
esReplicaCount :: Int
esShardCount :: Int
esIndex :: Text
esServer :: Text
esLoginInsecure :: ElasticSearchConfig -> Bool
esLogin :: ElasticSearchConfig -> Maybe (Text, Text)
esMapping :: ElasticSearchConfig -> Text
esReplicaCount :: ElasticSearchConfig -> Int
esShardCount :: ElasticSearchConfig -> Int
esIndex :: ElasticSearchConfig -> Text
esServer :: ElasticSearchConfig -> Text
..} = do
ElasticSearchConfig -> IO ()
checkElasticSearchLogin ElasticSearchConfig
esConf
EsEnv
env <- ElasticSearchConfig -> IO EsEnv
mkEsEnv ElasticSearchConfig
esConf
IORef (Maybe EsVersion)
versionRef <- Maybe EsVersion -> IO (IORef (Maybe EsVersion))
forall a. a -> IO (IORef a)
newIORef Maybe EsVersion
forall a. Maybe a
Nothing
IORef Text
indexRef <- Text -> IO (IORef Text)
forall a. a -> IO (IORef a)
newIORef Text
T.empty
Text -> ([LogMessage] -> IO ()) -> IO () -> IO Logger
mkBulkLogger Text
"ElasticSearch" (\[LogMessage]
msgs -> do
UTCTime
now <- IO UTCTime
getCurrentTime
Text
oldIndex <- IORef Text -> IO Text
forall a. IORef a -> IO a
readIORef IORef Text
indexRef
IORef (Maybe EsVersion) -> IO () -> IO ()
forall r. IORef (Maybe EsVersion) -> IO r -> IO r
retryOnException IORef (Maybe EsVersion)
versionRef (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
EsVersion
version <- IORef (Maybe EsVersion) -> IO (Maybe EsVersion)
forall a. IORef a -> IO a
readIORef IORef (Maybe EsVersion)
versionRef IO (Maybe EsVersion)
-> (Maybe EsVersion -> IO EsVersion) -> IO EsVersion
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just EsVersion
version -> EsVersion -> IO EsVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure EsVersion
version
Maybe EsVersion
Nothing -> EsEnv -> IO (Either HttpException (Response Value))
serverInfo EsEnv
env IO (Either HttpException (Response Value))
-> (Either HttpException (Response Value) -> IO EsVersion)
-> IO EsVersion
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left (HttpException
ex :: HttpException) -> [Char] -> IO EsVersion
forall a. HasCallStack => [Char] -> a
error
([Char] -> IO EsVersion) -> [Char] -> IO EsVersion
forall a b. (a -> b) -> a -> b
$ [Char]
"elasticSearchLogger: unexpected error: "
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> HttpException -> [Char]
forall a. Show a => a -> [Char]
show HttpException
ex
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" (is ElasticSearch server running?)"
Right Response Value
reply -> case Value -> Maybe EsVersion
parseEsVersion (Value -> Maybe EsVersion) -> Value -> Maybe EsVersion
forall a b. (a -> b) -> a -> b
$ Response Value -> Value
forall body. Response body -> body
responseBody Response Value
reply of
Maybe EsVersion
Nothing -> [Char] -> IO EsVersion
forall a. HasCallStack => [Char] -> a
error
([Char] -> IO EsVersion) -> [Char] -> IO EsVersion
forall a b. (a -> b) -> a -> b
$ [Char]
"elasticSearchLogger: invalid response when parsing version number: "
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Response Value -> [Char]
forall a. Show a => a -> [Char]
show Response Value
reply
Just EsVersion
version -> EsVersion -> IO EsVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure EsVersion
version
let index :: Text
index = [Text] -> Text
T.concat
[ Text
esIndex
, Text
"-"
, [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> [Char] -> UTCTime -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%F" UTCTime
now
]
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
oldIndex Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
index) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool
ixExists <- EsEnv -> Text -> IO Bool
indexExists EsEnv
env Text
index
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ixExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Response Value
reply <- EsVersion
-> EsEnv -> ElasticSearchConfig -> Text -> IO (Response Value)
createIndexWithMapping EsVersion
version EsEnv
env ElasticSearchConfig
esConf Text
index
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Response Value -> Bool
forall a. Response a -> Bool
isSuccess Response Value
reply) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Value -> IO ()
printEsError Text
"error while creating index" (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Response Value -> Value
forall body. Response body -> body
responseBody Response Value
reply
IORef Text -> Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Text
indexRef Text
index
let jsonMsgs :: Vector Object
jsonMsgs = [Object] -> Vector Object
forall a. [a] -> Vector a
V.fromList ([Object] -> Vector Object) -> [Object] -> Vector Object
forall a b. (a -> b) -> a -> b
$ (LogMessage -> Object) -> [LogMessage] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map LogMessage -> Object
toJsonMsg [LogMessage]
msgs
Value
reply <- Response Value -> Value
forall body. Response body -> body
responseBody (Response Value -> Value) -> IO (Response Value) -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EsVersion
-> EsEnv
-> ElasticSearchConfig
-> Text
-> Vector Object
-> IO (Response Value)
bulkIndex EsVersion
version EsEnv
env ElasticSearchConfig
esConf Text
index Vector Object
jsonMsgs
case Vector Object -> Value -> Maybe (Bool, Vector Object)
forall a. Vector a -> Value -> Maybe (Bool, Vector Object)
checkForBulkErrors Vector Object
jsonMsgs Value
reply of
Maybe (Bool, Vector Object)
Nothing -> Text -> Value -> IO ()
printEsError Text
"unexpected response" Value
reply
Just (Bool
hasErrors, Vector Object
responses) -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasErrors (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let newMsgs :: Vector Object
newMsgs =
let modifyData :: Maybe Value -> Value -> Value
modifyData :: Maybe Value -> Value -> Value
modifyData Maybe Value
merr (Object Object
hm) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$
let newData :: Object
newData = (Key -> Value -> Object -> Object) -> Object -> Object -> Object
forall v a. (Key -> v -> a -> a) -> a -> KeyMap v -> a
AC.foldrWithKey Key -> Value -> Object -> Object
keyAddValueTypeSuffix Object
forall v. KeyMap v
AC.empty Object
hm
in case Maybe Value
merr of
Just Value
err -> Object
newData Object -> Object -> Object
forall v. KeyMap v -> KeyMap v -> KeyMap v
`AC.union` Key -> Value -> Object
forall v. Key -> v -> KeyMap v
AC.singleton Key
"__es_error" Value
err
Maybe Value
Nothing -> Object
newData
modifyData Maybe Value
_ Value
v = Value
v
keyAddValueTypeSuffix :: Key -> Value -> Object -> Object
keyAddValueTypeSuffix Key
k Value
v Object
acc = Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
AC.insert
(case Value
v of
Object{} -> Key
k Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
"_object"
Array{} -> Key
k Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
"_array"
String{} -> Key
k Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
"_string"
Number{} -> Key
k Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
"_number"
Bool{} -> Key
k Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
"_bool"
Null{} -> Key
k Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
"_null"
) (Maybe Value -> Value -> Value
modifyData Maybe Value
forall a. Maybe a
Nothing Value
v) Object
acc
in (Maybe Value -> Value -> Value)
-> Vector Object -> Vector Object -> Vector Object
forall err obj.
(Maybe err -> obj -> obj)
-> Vector (KeyMap obj)
-> Vector (KeyMap err)
-> Vector (KeyMap obj)
adjustFailedMessagesWith Maybe Value -> Value -> Value
modifyData Vector Object
jsonMsgs Vector Object
responses
Value
newReply <- Response Value -> Value
forall body. Response body -> body
responseBody (Response Value -> Value) -> IO (Response Value) -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EsVersion
-> EsEnv
-> ElasticSearchConfig
-> Text
-> Vector Object
-> IO (Response Value)
bulkIndex EsVersion
version EsEnv
env ElasticSearchConfig
esConf Text
index Vector Object
newMsgs
case Vector Object -> Value -> Maybe (Bool, Vector Object)
forall a. Vector a -> Value -> Maybe (Bool, Vector Object)
checkForBulkErrors Vector Object
newMsgs Value
newReply of
Maybe (Bool, Vector Object)
Nothing -> Text -> Value -> IO ()
printEsError Text
"unexpected response" Value
newReply
Just (Bool
newHasErrors, Vector Object
newResponses) -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
newHasErrors (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let newerMsgs :: Vector Object
newerMsgs =
let modifyData :: Maybe Value -> Value -> Value
modifyData :: Maybe Value -> Value -> Value
modifyData (Just Value
err) Object{} = [Pair] -> Value
object [ Key
"__es_error" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
err ]
modifyData Maybe Value
_ Value
v = Value
v
in (Maybe Value -> Value -> Value)
-> Vector Object -> Vector Object -> Vector Object
forall err obj.
(Maybe err -> obj -> obj)
-> Vector (KeyMap obj)
-> Vector (KeyMap err)
-> Vector (KeyMap obj)
adjustFailedMessagesWith Maybe Value -> Value -> Value
modifyData Vector Object
newMsgs Vector Object
newResponses
IO (Response Value) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Response Value) -> IO ()) -> IO (Response Value) -> IO ()
forall a b. (a -> b) -> a -> b
$ EsVersion
-> EsEnv
-> ElasticSearchConfig
-> Text
-> Vector Object
-> IO (Response Value)
bulkIndex EsVersion
version EsEnv
env ElasticSearchConfig
esConf Text
index Vector Object
newerMsgs)
(EsEnv -> Text -> IO ()
refreshIndex EsEnv
env (Text -> IO ()) -> IO Text -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef Text -> IO Text
forall a. IORef a -> IO a
readIORef IORef Text
indexRef)
where
checkForBulkErrors
:: V.Vector a
-> Value
-> Maybe (Bool, V.Vector Object)
checkForBulkErrors :: Vector a -> Value -> Maybe (Bool, Vector Object)
checkForBulkErrors Vector a
jsonMsgs Value
replyBody = do
Object Object
response <- Value -> Maybe Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
replyBody
Bool Bool
hasErrors <- Key
"errors" Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
`AC.lookup` Object
response
Array Array
jsonItems <- Key
"items" Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
`AC.lookup` Object
response
Vector Object
items <- Array -> (Value -> Maybe Object) -> Maybe (Vector Object)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
F.forM Array
jsonItems ((Value -> Maybe Object) -> Maybe (Vector Object))
-> (Value -> Maybe Object) -> Maybe (Vector Object)
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Object Object
item <- Value -> Maybe Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
Object Object
index_ <- Key
"index" Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
`AC.lookup` Object
item
Maybe Value -> Maybe Value -> Maybe Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Key
"create" Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
`AC.lookup` Object
item
Object -> Maybe Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
index_
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Vector Object -> Int
forall a. Vector a -> Int
V.length Vector Object
items Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
jsonMsgs
(Bool, Vector Object) -> Maybe (Bool, Vector Object)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
hasErrors, Vector Object
items)
adjustFailedMessagesWith
:: (Maybe err -> obj -> obj)
-> V.Vector (AC.KeyMap obj)
-> V.Vector (AC.KeyMap err)
-> V.Vector (AC.KeyMap obj)
adjustFailedMessagesWith :: (Maybe err -> obj -> obj)
-> Vector (KeyMap obj)
-> Vector (KeyMap err)
-> Vector (KeyMap obj)
adjustFailedMessagesWith Maybe err -> obj -> obj
f Vector (KeyMap obj)
jsonMsgs Vector (KeyMap err)
responses =
let failed :: Vector (Int, err)
failed = (Int -> KeyMap err -> Maybe (Int, err))
-> Vector (KeyMap err) -> Vector (Int, err)
forall a b. (Int -> a -> Maybe b) -> Vector a -> Vector b
V.imapMaybe (\Int
n KeyMap err
item -> (Int
n, ) (err -> (Int, err)) -> Maybe err -> Maybe (Int, err)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key
"error" Key -> KeyMap err -> Maybe err
forall v. Key -> KeyMap v -> Maybe v
`AC.lookup` KeyMap err
item) Vector (KeyMap err)
responses
adjust :: (v -> v) -> Key -> KeyMap v -> KeyMap v
adjust v -> v
act Key
key KeyMap v
m = case Key -> KeyMap v -> Maybe v
forall v. Key -> KeyMap v -> Maybe v
AC.lookup Key
key KeyMap v
m of
Maybe v
Nothing -> KeyMap v
m
Just v
v -> Key -> v -> KeyMap v -> KeyMap v
forall v. Key -> v -> KeyMap v -> KeyMap v
AC.insert Key
key (v -> v
act v
v) KeyMap v
m
in (((Int, err) -> KeyMap obj)
-> Vector (Int, err) -> Vector (KeyMap obj)
forall a b. (a -> b) -> Vector a -> Vector b
`V.map` Vector (Int, err)
failed) (((Int, err) -> KeyMap obj) -> Vector (KeyMap obj))
-> ((Int, err) -> KeyMap obj) -> Vector (KeyMap obj)
forall a b. (a -> b) -> a -> b
$ \(Int
n, err
err) -> (obj -> obj) -> Key -> KeyMap obj -> KeyMap obj
forall v. (v -> v) -> Key -> KeyMap v -> KeyMap v
adjust (Maybe err -> obj -> obj
f (Maybe err -> obj -> obj) -> Maybe err -> obj -> obj
forall a b. (a -> b) -> a -> b
$ err -> Maybe err
forall a. a -> Maybe a
Just err
err) Key
"data" (KeyMap obj -> KeyMap obj) -> KeyMap obj -> KeyMap obj
forall a b. (a -> b) -> a -> b
$ Vector (KeyMap obj)
jsonMsgs Vector (KeyMap obj) -> Int -> KeyMap obj
forall a. Vector a -> Int -> a
V.! Int
n
printEsError :: Text -> Value -> IO ()
printEsError Text
msg Value
body =
Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"elasticSearchLogger: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
prettyJson Value
body
retryOnException :: forall r. IORef (Maybe EsVersion) -> IO r -> IO r
retryOnException :: IORef (Maybe EsVersion) -> IO r -> IO r
retryOnException IORef (Maybe EsVersion)
versionRef IO r
m = IO r -> IO (Either SomeException r)
forall e a. Exception e => IO a -> IO (Either e a)
try IO r
m IO (Either SomeException r)
-> (Either SomeException r -> IO r) -> IO r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left (SomeException
ex::SomeException) -> do
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"ElasticSearch: unexpected error: "
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
ex [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
", retrying in 10 seconds"
IORef (Maybe EsVersion) -> Maybe EsVersion -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe EsVersion)
versionRef Maybe EsVersion
forall a. Maybe a
Nothing
Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000
IORef (Maybe EsVersion) -> IO r -> IO r
forall r. IORef (Maybe EsVersion) -> IO r -> IO r
retryOnException IORef (Maybe EsVersion)
versionRef IO r
m
Right r
result -> r -> IO r
forall (m :: * -> *) a. Monad m => a -> m a
return r
result
prettyJson :: Value -> T.Text
prettyJson :: Value -> Text
prettyJson = Text -> Text
TL.toStrict
(Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
T.toLazyText
(Builder -> Text) -> (Value -> Builder) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Value -> Builder
forall a. ToJSON a => Config -> a -> Builder
encodePrettyToTextBuilder' Config
defConfig { confIndent :: Indent
confIndent = Int -> Indent
Spaces Int
2 }
toJsonMsg :: LogMessage -> Object
toJsonMsg :: LogMessage -> Object
toJsonMsg LogMessage
msg = let Object Object
jMsg = LogMessage -> Value
forall a. ToJSON a => a -> Value
toJSON LogMessage
msg in Object
jMsg
checkElasticSearchLogin :: ElasticSearchConfig -> IO ()
checkElasticSearchLogin :: ElasticSearchConfig -> IO ()
checkElasticSearchLogin ElasticSearchConfig{Bool
Int
Maybe (Text, Text)
Text
esLoginInsecure :: Bool
esLogin :: Maybe (Text, Text)
esMapping :: Text
esReplicaCount :: Int
esShardCount :: Int
esIndex :: Text
esServer :: Text
esLoginInsecure :: ElasticSearchConfig -> Bool
esLogin :: ElasticSearchConfig -> Maybe (Text, Text)
esMapping :: ElasticSearchConfig -> Text
esReplicaCount :: ElasticSearchConfig -> Int
esShardCount :: ElasticSearchConfig -> Int
esIndex :: ElasticSearchConfig -> Text
esServer :: ElasticSearchConfig -> Text
..} =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Text, Text) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Text, Text)
esLogin
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
esLoginInsecure
Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
"https:" Text -> Text -> Bool
`T.isPrefixOf` Text
esServer)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"ElasticSearch: insecure login: "
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"Attempting to send login credentials over an insecure connection. "
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"Set esLoginInsecure = True to disable this check."
checkElasticSearchConnection :: ElasticSearchConfig -> IO (Either HttpException ())
checkElasticSearchConnection :: ElasticSearchConfig -> IO (Either HttpException ())
checkElasticSearchConnection ElasticSearchConfig
esConf =
(Response Value -> ())
-> Either HttpException (Response Value) -> Either HttpException ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> Response Value -> ()
forall a b. a -> b -> a
const ()) (Either HttpException (Response Value) -> Either HttpException ())
-> IO (Either HttpException (Response Value))
-> IO (Either HttpException ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EsEnv -> IO (Either HttpException (Response Value))
serverInfo (EsEnv -> IO (Either HttpException (Response Value)))
-> IO EsEnv -> IO (Either HttpException (Response Value))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ElasticSearchConfig -> IO EsEnv
mkEsEnv ElasticSearchConfig
esConf)