@@ -1,8 +1,10 @@
11{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE FlexibleContexts #-}
23{-# LANGUAGE OverloadedStrings #-}
34{-# LANGUAGE RankNTypes #-}
45{-# LANGUAGE RecordWildCards #-}
56{-# LANGUAGE ScopedTypeVariables #-}
7+{-# LANGUAGE TypeFamilies #-}
68-- | Includes a scribe that can be used to log structured, JSON log
79-- messages to ElasticSearch. These logs can be explored easily using
810-- <https://www.elastic.co/products/kibana kibana> or your tool of
@@ -40,6 +42,10 @@ module Katip.Scribes.ElasticSearch
4042 , IndexShardingPolicy(..)
4143 , IndexNameSegment(..)
4244 , defaultEsScribeCfg
45+ , defaultEsScribeCfgV1
46+ , defaultEsScribeCfgV5
47+ , ESV1
48+ , ESV5
4349 -- * Utilities
4450 , mkDocId
4551 , module Katip.Scribes.ElasticSearch.Annotations
@@ -63,16 +69,18 @@ import Control.Retry (RetryPolicy,
6369 limitRetries,
6470 recovering)
6571import Data.Aeson
72+import Data.ByteString.Lazy (ByteString)
6673import Data.Monoid ((<>))
6774import Data.Text (Text)
6875import qualified Data.Text as T
6976import qualified Data.Text.Encoding as T
7077import Data.Time
7178import Data.Time.Calendar.WeekDate
72−import Data.Typeable
79+import Data.Typeable as Typeable
7380import Data.UUID
7481import qualified Data.UUID.V4 as UUID4
75−import Database.Bloodhound
82+import qualified Database.V1.Bloodhound as V1
83+import qualified Database.V5.Bloodhound as V5
7684import Network.HTTP.Client
7785import Network.HTTP.Types.Status
7886import Text.Printf (printf)
@@ -82,7 +90,7 @@ import Katip.Scribes.ElasticSearch.Annotations
8290-------------------------------------------------------------------------------
8391
8492
85−data EsScribeCfg = EsScribeCfg {
93+data EsScribeCfg v = EsScribeCfg {
8694 essRetryPolicy :: RetryPolicy
8795 -- ^ Retry policy when there are errors sending logs to the server
8896 , essQueueSize :: EsQueueSize
@@ -102,7 +110,7 @@ data EsScribeCfg = EsScribeCfg {
102110 -- exposes a querying API, we will try to make deserialization and
103111 -- querying transparently remove the type annotations if this is
104112 -- enabled.
105− , essIndexSettings :: IndexSettings
113+ , essIndexSettings :: IndexSettings v
106114 , essIndexSharding :: IndexShardingPolicy
107115 } deriving (Typeable)
108116
@@ -120,15 +128,30 @@ data EsScribeCfg = EsScribeCfg {
120128-- * Annotate types set to False
121129--
122130-- * DailyIndexSharding
123−defaultEsScribeCfg :: EsScribeCfg
131+defaultEsScribeCfg :: forall v. ESVersion v => EsScribeCfg v
124132defaultEsScribeCfg = EsScribeCfg {
125133 essRetryPolicy = exponentialBackoff 25 <> limitRetries 5
126134 , essQueueSize = EsQueueSize 1000
127135 , essPoolSize = EsPoolSize 2
128136 , essAnnotateTypes = False
129− , essIndexSettings = defaultIndexSettings
137+ , essIndexSettings = defaultIndexSettings prx
130138 , essIndexSharding = DailyIndexSharding
131139 }
140+ where
141+ prx :: Typeable.Proxy v
142+ prx = Typeable.Proxy
143+
144+
145+-------------------------------------------------------------------------------
146+-- | EsScribeCfg that will use ElasticSearch V1
147+defaultEsScribeCfgV1 :: EsScribeCfg ESV1
148+defaultEsScribeCfgV1 = defaultEsScribeCfg
149+
150+
151+-------------------------------------------------------------------------------
152+-- | EsScribeCfg that will use ElasticSearch V5
153+defaultEsScribeCfgV5 :: EsScribeCfg ESV5
154+defaultEsScribeCfgV5 = defaultEsScribeCfg
132155
133156
134157-------------------------------------------------------------------------------
@@ -224,9 +247,9 @@ roundToSunday d
224247
225248
226249-------------------------------------------------------------------------------
227−chooseIxn :: IndexName -> IndexShardingPolicy -> Item a -> IndexName
228−chooseIxn (IndexName ixn) p i =
229− IndexName (T.intercalate "-" (ixn:segs))
250+chooseIxn :: ESVersion v => proxy v -> IndexName v -> IndexShardingPolicy -> Item a -> IndexName v
251+chooseIxn prx ixn p i =
252+ toIndexName prx (T.intercalate "-" ((fromIndexName prx ixn):segs))
230253 where
231254 segs = indexNameSegment A.<$> shardPolicySegs p i
232255
@@ -246,19 +269,23 @@ splitTime t = asMins `divMod` 60
246269
247270
248271-------------------------------------------------------------------------------
249−data EsScribeSetupError = CouldNotCreateIndex !Reply
250− | CouldNotCreateMapping !Reply deriving (Typeable, Show)
272+data EsScribeSetupError = CouldNotCreateIndex !(Response ByteString)
273+ | CouldNotCreateMapping !(Response ByteString) deriving (Typeable, Show)
251274
252275
253276instance Exception EsScribeSetupError
254277
278+
255279-------------------------------------------------------------------------------
256280mkEsScribe
257− :: EsScribeCfg
258− -> BHEnv
259− -> IndexName
281+ :: forall v. ( ESVersion v
282+ , MonadIO (BH v IO)
283+ )
284+ => EsScribeCfg v
285+ -> BHEnv v
286+ -> IndexName v
260287 -- ^ Treated as a prefix if index sharding is enabled
261− -> MappingName
288+ -> MappingName v
262289 -> Severity
263290 -> Verbosity
264291 -> IO Scribe
@@ -266,17 +293,17 @@ mkEsScribe cfg@EsScribeCfg {..} env ix mapping sev verb = do
266293 q <- newTBMQueueIO $ unEsQueueSize essQueueSize
267294 endSig <- newEmptyMVar
268295
269− runBH env $ do
270− chk <- indexExists ix
296+ runBH prx env $ do
297+ chk <- indexExists prx ix
271298 -- note that this doesn't update settings. That's not available
272299 -- through the Bloodhound API yet
273300 unless chk $ void $ do
274− r1 <- createIndex essIndexSettings ix
301+ r1 <- createIndex prx essIndexSettings ix
275302 unless (statusIsSuccessful (responseStatus r1)) $
276303 liftIO $ throwIO (CouldNotCreateIndex r1)
277304 r2 <- if shardingEnabled
278− then putTemplate tpl tplName
279− else putMapping ix mapping (baseMapping mapping)
305+ then putTemplate prx tpl tplName
306+ else putMapping prx ix mapping base
280307 unless (statusIsSuccessful (responseStatus r2)) $
281308 liftIO $ throwIO (CouldNotCreateMapping r2)
282309
@@ -289,27 +316,31 @@ mkEsScribe cfg@EsScribeCfg {..} env ix mapping sev verb = do
289316 mapM_ waitCatch workers
290317 putMVar endSig ()
291318
292− let logger i =
293− when (_itemSeverity i >= sev) $
294− void $ atomically $ tryWriteTBMQueue q (chooseIxn ix essIndexSharding i, itemJson' i)
295319 let finalizer = putMVar endSig () >> takeMVar endSig
296− return (Scribe logger finalizer)
320+ return (Scribe (logger q) finalizer)
297321 where
298− tplName = TemplateName ixn
322+ logger :: forall a. LogItem a => TBMQueue (IndexName v, Value) -> Item a -> IO ()
323+ logger q i = when (_itemSeverity i >= sev) $
324+ void $ atomically $ tryWriteTBMQueue q (chooseIxn prx ix essIndexSharding i, itemJson' i)
325+ prx :: Typeable.Proxy v
326+ prx = Typeable.Proxy
327+ tplName = toTemplateName prx ixn
299328 shardingEnabled = case essIndexSharding of
300329 NoIndexSharding -> False
301330 _ -> True
302− tpl = IndexTemplate (TemplatePattern (ixn <> "-*")) (Just essIndexSettings) [toJSON (baseMapping mapping)]
303− IndexName ixn = ix
331+ tpl = toIndexTemplate prx (toTemplatePattern prx (ixn <> "-*")) (Just essIndexSettings) [toJSON base]
332+ base = baseMapping prx mapping
333+ ixn = fromIndexName prx ix
334+ itemJson' :: LogItem a => Item a -> Value
304335 itemJson' i
305336 | essAnnotateTypes = itemJson verb (TypeAnnotated <$> i)
306337 | otherwise = itemJson verb i
307338
308339
309340-------------------------------------------------------------------------------
310−baseMapping :: MappingName -> Value
311−baseMapping (MappingName mn) =
312− object [ mn .= object ["properties" .= object prs] ]
341+baseMapping :: ESVersion v => proxy v -> MappingName v -> Value
342+baseMapping prx mn =
343+ object [ fromMappingName prx mn .= object ["properties" .= object prs] ]
313344 where prs = [ str "thread"
314345 , str "sev"
315346 , str "pid"
@@ -341,8 +372,8 @@ esDateFormat = "yyyy-MM-dd'T'HH:mm:ssZ||yyyy-MM-dd'T'HH:mm:ss.SSSZ||yyyy-MM-dd'T
341372
342373
343374-------------------------------------------------------------------------------
344−mkDocId :: IO DocId
345−mkDocId = (DocId . T.decodeUtf8 . toASCIIBytes) `fmap` UUID4.nextRandom
375+mkDocId :: ESVersion v => proxy v -> IO (DocId v)
376+mkDocId prx = (toDocId prx . T.decodeUtf8 . toASCIIBytes) `fmap` UUID4.nextRandom
346377
347378
348379-------------------------------------------------------------------------------
@@ -384,10 +415,11 @@ mkNonZero ctor n
384415
385416-------------------------------------------------------------------------------
386417startWorker
387− :: EsScribeCfg
388− -> BHEnv
389− -> MappingName
390− -> TBMQueue (IndexName, Value)
418+ :: forall v. (ESVersion v)
419+ => EsScribeCfg v
420+ -> BHEnv v
421+ -> MappingName v
422+ -> TBMQueue (IndexName v, Value)
391423 -> IO ()
392424startWorker EsScribeCfg {..} env mapping q = go
393425 where
@@ -398,13 +430,112 @@ startWorker EsScribeCfg {..} env mapping q = go
398430 sendLog ixn v `catchAny` eat
399431 go
400432 Nothing -> return ()
401− sendLog :: IndexName -> Value -> IO ()
433+ prx :: Typeable.Proxy v
434+ prx = Typeable.Proxy
435+ sendLog :: IndexName v -> Value -> IO ()
402436 sendLog ixn v = void $ recovering essRetryPolicy [handler] $ const $ do
403− did <- mkDocId
404− res <- runBH env $ indexDocument ixn mapping defaultIndexDocumentSettings v did
437+ did <- mkDocId prx
438+ res <- runBH prx env $ indexDocument prx ixn mapping (defaultIndexDocumentSettings prx) v did
405439 return res
406440 eat _ = return ()
407441 handler _ = Handler $ \e ->
408442 case fromException e of
409443 Just (_ :: AsyncException) -> return False
410− _ -> return True
444+ _ -> return True
445+
446+
447+-------------------------------------------------------------------------------
448+-- We are spanning multiple versions of ES which use completely
449+-- separate types and APIs, but the subset we use is the same for both
450+-- versions. This will be kept up to date with bloodhound's supported
451+-- versions and should be minimally visible to the end user.
452+class ESVersion v where
453+ -- Types
454+ type BHEnv v
455+ type IndexSettings v
456+ defaultIndexSettings :: proxy v -> IndexSettings v
457+ type IndexName v
458+ toIndexName :: proxy v -> Text -> IndexName v
459+ fromIndexName :: proxy v -> IndexName v -> Text
460+ type MappingName v
461+ fromMappingName :: proxy v -> MappingName v -> Text
462+ type DocId v
463+ toDocId :: proxy v -> Text -> DocId v
464+ type BH v :: (* -> *) -> * -> *
465+ runBH :: proxy v -> BHEnv v -> BH v m a -> m a
466+ type TemplateName v
467+ toTemplateName :: proxy v -> Text -> TemplateName v
468+ type TemplatePattern v
469+ toTemplatePattern :: proxy v -> Text -> TemplatePattern v
470+ type IndexTemplate v
471+ toIndexTemplate :: proxy v -> TemplatePattern v -> Maybe (IndexSettings v) -> [Value] -> IndexTemplate v
472+ type IndexDocumentSettings v
473+ defaultIndexDocumentSettings :: proxy v -> IndexDocumentSettings v
474+
475+ -- Operations
476+ -- We're deciding on IO here, but it isn't necessary
477+ indexExists :: proxy v -> IndexName v -> BH v IO Bool
478+ indexDocument :: ToJSON doc => proxy v -> IndexName v -> MappingName v -> IndexDocumentSettings v -> doc -> DocId v -> BH v IO (Response ByteString)
479+ createIndex :: proxy v -> IndexSettings v -> IndexName v -> BH v IO (Response ByteString)
480+ putTemplate :: proxy v -> IndexTemplate v -> TemplateName v -> BH v IO (Response ByteString)
481+ putMapping :: (ToJSON a) => proxy v -> IndexName v -> MappingName v -> a -> BH v IO (Response ByteString)
482+
483+
484+data ESV1
485+
486+instance ESVersion ESV1 where
487+ type BHEnv ESV1 = V1.BHEnv
488+ type IndexSettings ESV1 = V1.IndexSettings
489+ defaultIndexSettings _ = V1.defaultIndexSettings
490+ type IndexName ESV1 = V1.IndexName
491+ toIndexName _ = V1.IndexName
492+ fromIndexName _ (V1.IndexName x) = x
493+ type MappingName ESV1 = V1.MappingName
494+ fromMappingName _ (V1.MappingName x) = x
495+ type DocId ESV1 = V1.DocId
496+ toDocId _ = V1.DocId
497+ type BH ESV1 = V1.BH
498+ runBH _ = V1.runBH
499+ type TemplateName ESV1 = V1.TemplateName
500+ toTemplateName _ = V1.TemplateName
501+ type TemplatePattern ESV1 = V1.TemplatePattern
502+ toTemplatePattern _ = V1.TemplatePattern
503+ type IndexTemplate ESV1 = V1.IndexTemplate
504+ toIndexTemplate _ = V1.IndexTemplate
505+ type IndexDocumentSettings ESV1 = V1.IndexDocumentSettings
506+ defaultIndexDocumentSettings _ = V1.defaultIndexDocumentSettings
507+ indexExists _ = V1.indexExists
508+ indexDocument _ = V1.indexDocument
509+ createIndex _ = V1.createIndex
510+ putTemplate _ = V1.putTemplate
511+ putMapping _ = V1.putMapping
512+
513+
514+data ESV5
515+
516+instance ESVersion ESV5 where
517+ type BHEnv ESV5 = V5.BHEnv
518+ type IndexSettings ESV5 = V5.IndexSettings
519+ defaultIndexSettings _ = V5.defaultIndexSettings
520+ type IndexName ESV5 = V5.IndexName
521+ toIndexName _ = V5.IndexName
522+ fromIndexName _ (V5.IndexName x) = x
523+ type MappingName ESV5 = V5.MappingName
524+ fromMappingName _ (V5.MappingName x) = x
525+ type DocId ESV5 = V5.DocId
526+ toDocId _ = V5.DocId
527+ type BH ESV5 = V5.BH
528+ runBH _ = V5.runBH
529+ type TemplateName ESV5 = V5.TemplateName
530+ toTemplateName _ = V5.TemplateName
531+ type TemplatePattern ESV5 = V5.TemplatePattern
532+ toTemplatePattern _ = V5.TemplatePattern
533+ type IndexTemplate ESV5 = V5.IndexTemplate
534+ toIndexTemplate _ = V5.IndexTemplate
535+ type IndexDocumentSettings ESV5 = V5.IndexDocumentSettings
536+ defaultIndexDocumentSettings _ = V5.defaultIndexDocumentSettings
537+ indexExists _ = V5.indexExists
538+ indexDocument _ = V5.indexDocument
539+ createIndex _ = V5.createIndex
540+ putTemplate _ = V5.putTemplate
541+ putMapping _ = V5.putMapping