@@ -1,4 +1,5 @@
11{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE OverloadedStrings #-}
23{-# LANGUAGE RankNTypes #-}
34{-# LANGUAGE RecordWildCards #-}
45{-# LANGUAGE ScopedTypeVariables #-}
@@ -6,6 +7,7 @@ module Katip.Scribes.ElasticSearch
67 (-- * Building a scribe
78 mkEsScribe
89 -- * Scribe configuration
10+ , EsScribeSetupError(..)
911 , EsQueueSize
1012 , mkEsQueueSize
1113 , EsPoolSize
@@ -25,6 +27,8 @@ module Katip.Scribes.ElasticSearch
2527
2628
2729-------------------------------------------------------------------------------
30+import Control.Monad.IO.Class
31+
2832import Control.Applicative
2933import Control.Concurrent
3034import Control.Concurrent.Async
@@ -40,11 +44,13 @@ import Control.Retry (RetryPolicy,
4044 recovering)
4145import Data.Aeson
4246import Data.Monoid ((<>))
47+import Data.Text (Text)
4348import qualified Data.Text.Encoding as T
4449import Data.Typeable
4550import Data.UUID
4651import Database.Bloodhound
4752import Network.HTTP.Client
53+import Network.HTTP.Types.Status
4854import System.Random
4955-------------------------------------------------------------------------------
5056import Katip.Core
@@ -100,6 +106,12 @@ defaultEsScribeCfg = EsScribeCfg {
100106 }
101107
102108
109+-------------------------------------------------------------------------------
110+data EsScribeSetupError = CouldNotCreateIndex !Reply
111+ | CouldNotCreateMapping !Reply deriving (Typeable, Show)
112+
113+
114+instance Exception EsScribeSetupError
103115
104116-------------------------------------------------------------------------------
105117mkEsScribe
@@ -123,7 +135,14 @@ mkEsScribe cfg@EsScribeCfg {..} server ix mapping sev verb = do
123135 chk <- indexExists ix
124136 -- note that this doesn't update settings. That's not available
125137 -- through the Bloodhound API yet
126− unless chk $ void $ createIndex essIndexSettings ix
138+ unless chk $ void $ do
139+ r1 <- createIndex essIndexSettings ix
140+ unless (statusIsSuccessful (responseStatus r1)) $
141+ liftIO $ throwIO (CouldNotCreateIndex r1)
142+ --TODO: throw on error
143+ r2 <- putMapping ix mapping (baseMapping mapping)
144+ unless (statusIsSuccessful (responseStatus r2)) $
145+ liftIO $ throwIO (CouldNotCreateMapping r2)
127146
128147 workers <- replicateM (unEsPoolSize essPoolSize) $ async $
129148 startWorker cfg env ix mapping q
@@ -145,6 +164,40 @@ mkEsScribe cfg@EsScribeCfg {..} server ix mapping sev verb = do
145164 | otherwise = itemJson v i
146165
147166
167+-------------------------------------------------------------------------------
168+baseMapping :: MappingName -> Value
169+baseMapping (MappingName mn) =
170+ object [ mn .= object ["properties" .= object pairs] ]
171+ where pairs = [ str "thread"
172+ , str "sev"
173+ , str "pid"
174+ , str "ns"
175+ , str "msg"
176+ , "loc" .= locType
177+ , str "host"
178+ , str "env"
179+ , "at" .= dateType
180+ , str "app"
181+ ]
182+ str k = k .= object ["type" .= String "string"]
183+ locType = object ["properties" .= object locPairs]
184+ locPairs = [ str "loc_pkg"
185+ , str "loc_mod"
186+ , str "loc_ln"
187+ , str "loc_fn"
188+ , str "loc_col"
189+ ]
190+ dateType = object [ "format" .= esDateFormat
191+ , "type" .= String "date"
192+ ]
193+
194+
195+-------------------------------------------------------------------------------
196+-- | Handle both old-style aeson and picosecond-level precision
197+esDateFormat :: Text
198+esDateFormat = "yyyy-MM-dd'T'HH:mm:ss.SSSZ||yyyy-MM-dd'T'HH:mm:ss.SSSSSSSSSSSSZ"
199+
200+
148201-------------------------------------------------------------------------------
149202mkDocId :: IO DocId
150203mkDocId = (DocId . T.decodeUtf8 . toASCIIBytes) `fmap` randomIO