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.HashMap.Strict as H
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
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 (HashMap Text Value)
jsonMsgs = [HashMap Text Value] -> Vector (HashMap Text Value)
forall a. [a] -> Vector a
V.fromList ([HashMap Text Value] -> Vector (HashMap Text Value))
-> [HashMap Text Value] -> Vector (HashMap Text Value)
forall a b. (a -> b) -> a -> b
$ (LogMessage -> HashMap Text Value)
-> [LogMessage] -> [HashMap Text Value]
forall a b. (a -> b) -> [a] -> [b]
map LogMessage -> HashMap Text Value
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 (HashMap Text Value)
-> IO (Response Value)
bulkIndex EsVersion
version EsEnv
env ElasticSearchConfig
esConf Text
index Vector (HashMap Text Value)
jsonMsgs
case Vector (HashMap Text Value)
-> Value -> Maybe (Bool, Vector (HashMap Text Value))
forall a.
Vector a -> Value -> Maybe (Bool, Vector (HashMap Text Value))
checkForBulkErrors Vector (HashMap Text Value)
jsonMsgs Value
reply of
Maybe (Bool, Vector (HashMap Text Value))
Nothing -> Text -> Value -> IO ()
printEsError Text
"unexpected response" Value
reply
Just (Bool
hasErrors, Vector (HashMap Text Value)
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 (HashMap Text Value)
newMsgs =
let modifyData :: Maybe Value -> Value -> Value
modifyData :: Maybe Value -> Value -> Value
modifyData Maybe Value
merr (Object HashMap Text Value
hm) = HashMap Text Value -> Value
Object (HashMap Text Value -> Value) -> HashMap Text Value -> Value
forall a b. (a -> b) -> a -> b
$
let newData :: HashMap Text Value
newData = (HashMap Text Value -> Text -> Value -> HashMap Text Value)
-> HashMap Text Value -> HashMap Text Value -> HashMap Text Value
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
H.foldlWithKey' HashMap Text Value -> Text -> Value -> HashMap Text Value
forall a.
(Eq a, Hashable a, Semigroup a, IsString a) =>
HashMap a Value -> a -> Value -> HashMap a Value
keyAddValueTypeSuffix HashMap Text Value
forall k v. HashMap k v
H.empty HashMap Text Value
hm
in case Maybe Value
merr of
Just Value
err -> HashMap Text Value
newData HashMap Text Value -> HashMap Text Value -> HashMap Text Value
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
`H.union` Text -> Value -> HashMap Text Value
forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Text
"__es_error" Value
err
Maybe Value
Nothing -> HashMap Text Value
newData
modifyData Maybe Value
_ Value
v = Value
v
keyAddValueTypeSuffix :: HashMap a Value -> a -> Value -> HashMap a Value
keyAddValueTypeSuffix HashMap a Value
acc a
k Value
v = a -> Value -> HashMap a Value -> HashMap a Value
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert
(case Value
v of
Object{} -> a
k a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"_object"
Array{} -> a
k a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"_array"
String{} -> a
k a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"_string"
Number{} -> a
k a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"_number"
Bool{} -> a
k a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"_bool"
Null{} -> a
k a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"_null"
) (Maybe Value -> Value -> Value
modifyData Maybe Value
forall a. Maybe a
Nothing Value
v) HashMap a Value
acc
in (Maybe Value -> Value -> Value)
-> Vector (HashMap Text Value)
-> Vector (HashMap Text Value)
-> Vector (HashMap Text Value)
forall err obj.
(Maybe err -> obj -> obj)
-> Vector (HashMap Text obj)
-> Vector (HashMap Text err)
-> Vector (HashMap Text obj)
adjustFailedMessagesWith Maybe Value -> Value -> Value
modifyData Vector (HashMap Text Value)
jsonMsgs Vector (HashMap Text Value)
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 (HashMap Text Value)
-> IO (Response Value)
bulkIndex EsVersion
version EsEnv
env ElasticSearchConfig
esConf Text
index Vector (HashMap Text Value)
newMsgs
case Vector (HashMap Text Value)
-> Value -> Maybe (Bool, Vector (HashMap Text Value))
forall a.
Vector a -> Value -> Maybe (Bool, Vector (HashMap Text Value))
checkForBulkErrors Vector (HashMap Text Value)
newMsgs Value
newReply of
Maybe (Bool, Vector (HashMap Text Value))
Nothing -> Text -> Value -> IO ()
printEsError Text
"unexpected response" Value
newReply
Just (Bool
newHasErrors, Vector (HashMap Text Value)
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 (HashMap Text Value)
newerMsgs =
let modifyData :: Maybe Value -> Value -> Value
modifyData :: Maybe Value -> Value -> Value
modifyData (Just Value
err) Object{} = [Pair] -> Value
object [ Text
"__es_error" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
err ]
modifyData Maybe Value
_ Value
v = Value
v
in (Maybe Value -> Value -> Value)
-> Vector (HashMap Text Value)
-> Vector (HashMap Text Value)
-> Vector (HashMap Text Value)
forall err obj.
(Maybe err -> obj -> obj)
-> Vector (HashMap Text obj)
-> Vector (HashMap Text err)
-> Vector (HashMap Text obj)
adjustFailedMessagesWith Maybe Value -> Value -> Value
modifyData Vector (HashMap Text Value)
newMsgs Vector (HashMap Text Value)
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 (HashMap Text Value)
-> IO (Response Value)
bulkIndex EsVersion
version EsEnv
env ElasticSearchConfig
esConf Text
index Vector (HashMap Text Value)
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 (HashMap Text Value))
checkForBulkErrors Vector a
jsonMsgs Value
replyBody = do
Object HashMap Text Value
response <- Value -> Maybe Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
replyBody
Bool Bool
hasErrors <- Text
"errors" Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`H.lookup` HashMap Text Value
response
Array Array
jsonItems <- Text
"items" Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`H.lookup` HashMap Text Value
response
Vector (HashMap Text Value)
items <- Array
-> (Value -> Maybe (HashMap Text Value))
-> Maybe (Vector (HashMap Text Value))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
F.forM Array
jsonItems ((Value -> Maybe (HashMap Text Value))
-> Maybe (Vector (HashMap Text Value)))
-> (Value -> Maybe (HashMap Text Value))
-> Maybe (Vector (HashMap Text Value))
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Object HashMap Text Value
item <- Value -> Maybe Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
Object HashMap Text Value
index_ <- Text
"index" Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`H.lookup` HashMap Text Value
item
Maybe Value -> Maybe Value -> Maybe Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text
"create" Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`H.lookup` HashMap Text Value
item
HashMap Text Value -> Maybe (HashMap Text Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text Value
index_
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Vector (HashMap Text Value) -> Int
forall a. Vector a -> Int
V.length Vector (HashMap Text Value)
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 (HashMap Text Value))
-> Maybe (Bool, Vector (HashMap Text Value))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
hasErrors, Vector (HashMap Text Value)
items)
adjustFailedMessagesWith
:: (Maybe err -> obj -> obj)
-> V.Vector (H.HashMap T.Text obj)
-> V.Vector (H.HashMap T.Text err)
-> V.Vector (H.HashMap T.Text obj)
adjustFailedMessagesWith :: (Maybe err -> obj -> obj)
-> Vector (HashMap Text obj)
-> Vector (HashMap Text err)
-> Vector (HashMap Text obj)
adjustFailedMessagesWith Maybe err -> obj -> obj
f Vector (HashMap Text obj)
jsonMsgs Vector (HashMap Text err)
responses =
let failed :: Vector (Int, err)
failed = (Int -> HashMap Text err -> Maybe (Int, err))
-> Vector (HashMap Text err) -> Vector (Int, err)
forall a b. (Int -> a -> Maybe b) -> Vector a -> Vector b
V.imapMaybe (\Int
n HashMap Text err
item -> (Int
n, ) (err -> (Int, err)) -> Maybe err -> Maybe (Int, err)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
"error" Text -> HashMap Text err -> Maybe err
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`H.lookup` HashMap Text err
item) Vector (HashMap Text err)
responses
in (((Int, err) -> HashMap Text obj)
-> Vector (Int, err) -> Vector (HashMap Text obj)
forall a b. (a -> b) -> Vector a -> Vector b
`V.map` Vector (Int, err)
failed) (((Int, err) -> HashMap Text obj) -> Vector (HashMap Text obj))
-> ((Int, err) -> HashMap Text obj) -> Vector (HashMap Text obj)
forall a b. (a -> b) -> a -> b
$ \(Int
n, err
err) -> (obj -> obj) -> Text -> HashMap Text obj -> HashMap Text obj
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
H.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) Text
"data" (HashMap Text obj -> HashMap Text obj)
-> HashMap Text obj -> HashMap Text obj
forall a b. (a -> b) -> a -> b
$ Vector (HashMap Text obj)
jsonMsgs Vector (HashMap Text obj) -> Int -> HashMap Text 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 -> H.HashMap T.Text Value
toJsonMsg :: LogMessage -> HashMap Text Value
toJsonMsg LogMessage
msg = let Object HashMap Text Value
jMsg = LogMessage -> Value
forall a. ToJSON a => a -> Value
toJSON LogMessage
msg in HashMap Text Value
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)