fa6bdfa · typeable/katip

git.iko.soy/typeable/katip

on master help sign in

WIP, support bloodhound 0.13 and above

fa6bdfaMichael Xavier9 years ago

katip-elasticsearch/katip-elasticsearch.cabal+2−1

compare with master

unifiedsplit

@@ -28,7 +28,7 @@ library

28 build-depends:

29 base >=4.6 && <5

30 , katip >= 0.2.0.0 && < 0.5

31− , bloodhound >= 0.11.0.0 && < 0.13

31+ , bloodhound >= 0.13.0.0 && < 0.15

32 , uuid >= 1.3.12 && < 1.4

33 , aeson >=0.6 && <1.2

34 , stm >= 2.4.3 && < 2.5

@@ -44,6 +44,7 @@ library

44 , transformers >= 0.2 && < 0.6

45 , http-types >= 0.8 && < 0.10

46 , time >= 1 && < 1.7

47+ , bytestring

47 hs-source-dirs: src

48 hs-source-dirs: src

48 default-language: Haskell2010

49 default-language: Haskell2010

49 hs-source-dirs: src

50 hs-source-dirs: src

katip-elasticsearch/src/Katip/Scribes/ElasticSearch.hs+171−40

@@ -1,8 +1,10 @@

1{-# LANGUAGE DeriveDataTypeable #-}

2+{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE RankNTypes #-}

4{-# LANGUAGE RankNTypes #-}

4{-# LANGUAGE RecordWildCards #-}

5{-# LANGUAGE RecordWildCards #-}

5{-# LANGUAGE ScopedTypeVariables #-}

6{-# LANGUAGE ScopedTypeVariables #-}

7+{-# LANGUAGE TypeFamilies #-}

6-- | Includes a scribe that can be used to log structured, JSON log

8-- | Includes a scribe that can be used to log structured, JSON log

7-- messages to ElasticSearch. These logs can be explored easily using

9-- messages to ElasticSearch. These logs can be explored easily using

8-- <https://www.elastic.co/products/kibana kibana> or your tool of

10-- <https://www.elastic.co/products/kibana kibana> or your tool of

@@ -40,6 +42,10 @@ module Katip.Scribes.ElasticSearch

40 , IndexShardingPolicy(..)

42 , IndexShardingPolicy(..)

41 , IndexNameSegment(..)

43 , IndexNameSegment(..)

42 , defaultEsScribeCfg

44 , defaultEsScribeCfg

45+ , defaultEsScribeCfgV1

46+ , defaultEsScribeCfgV5

47+ , ESV1

48+ , ESV5

43 -- * Utilities

49 -- * Utilities

44 , mkDocId

50 , mkDocId

45 , module Katip.Scribes.ElasticSearch.Annotations

51 , module Katip.Scribes.ElasticSearch.Annotations

@@ -63,16 +69,18 @@ import Control.Retry (RetryPolicy,

63 limitRetries,

69 limitRetries,

64 recovering)

70 recovering)

65import Data.Aeson

71import Data.Aeson

72+import Data.ByteString.Lazy (ByteString)

66import Data.Monoid ((<>))

73import Data.Monoid ((<>))

67import Data.Text (Text)

74import Data.Text (Text)

68import qualified Data.Text as T

75import qualified Data.Text as T

69import qualified Data.Text.Encoding as T

76import qualified Data.Text.Encoding as T

70import Data.Time

77import Data.Time

71import Data.Time.Calendar.WeekDate

78import Data.Time.Calendar.WeekDate

72−import Data.Typeable

79+import Data.Typeable as Typeable

73import Data.UUID

80import Data.UUID

74import qualified Data.UUID.V4 as UUID4

81import qualified Data.UUID.V4 as UUID4

82+import qualified Database.V1.Bloodhound as V1

75−import Database.Bloodhound

83+import qualified Database.V5.Bloodhound as V5

76import Network.HTTP.Client

84import Network.HTTP.Client

77import Network.HTTP.Types.Status

85import Network.HTTP.Types.Status

78import Text.Printf (printf)

86import Text.Printf (printf)

@@ -82,7 +90,7 @@ import Katip.Scribes.ElasticSearch.Annotations

82-------------------------------------------------------------------------------

90-------------------------------------------------------------------------------

85−data EsScribeCfg = EsScribeCfg {

93+data EsScribeCfg v = EsScribeCfg {

86 essRetryPolicy :: RetryPolicy

94 essRetryPolicy :: RetryPolicy

87 -- ^ Retry policy when there are errors sending logs to the server

95 -- ^ Retry policy when there are errors sending logs to the server

88 , essQueueSize :: EsQueueSize

96 , essQueueSize :: EsQueueSize

@@ -102,7 +110,7 @@ data EsScribeCfg = EsScribeCfg {

102 -- exposes a querying API, we will try to make deserialization and

110 -- exposes a querying API, we will try to make deserialization and

103 -- querying transparently remove the type annotations if this is

111 -- querying transparently remove the type annotations if this is

104 -- enabled.

112 -- enabled.

105− , essIndexSettings :: IndexSettings

113+ , essIndexSettings :: IndexSettings v

106 , essIndexSharding :: IndexShardingPolicy

114 , essIndexSharding :: IndexShardingPolicy

107 } deriving (Typeable)

115 } deriving (Typeable)

108

116

@@ -120,15 +128,30 @@ data EsScribeCfg = EsScribeCfg {

120-- * Annotate types set to False

128-- * Annotate types set to False

121--

129--

122-- * DailyIndexSharding

130-- * DailyIndexSharding

123−defaultEsScribeCfg :: EsScribeCfg

131+defaultEsScribeCfg :: forall v. ESVersion v => EsScribeCfg v

124defaultEsScribeCfg = EsScribeCfg {

132defaultEsScribeCfg = EsScribeCfg {

125 essRetryPolicy = exponentialBackoff 25 <> limitRetries 5

133 essRetryPolicy = exponentialBackoff 25 <> limitRetries 5

126 , essQueueSize = EsQueueSize 1000

134 , essQueueSize = EsQueueSize 1000

127 , essPoolSize = EsPoolSize 2

135 , essPoolSize = EsPoolSize 2

128 , essAnnotateTypes = False

136 , essAnnotateTypes = False

129− , essIndexSettings = defaultIndexSettings

137+ , essIndexSettings = defaultIndexSettings prx

130 , essIndexSharding = DailyIndexSharding

138 , essIndexSharding = DailyIndexSharding

131 }

139 }

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

132

155

133

156

134-------------------------------------------------------------------------------

157-------------------------------------------------------------------------------

@@ -224,9 +247,9 @@ roundToSunday d

224

247

225

248

226-------------------------------------------------------------------------------

249-------------------------------------------------------------------------------

227−chooseIxn :: IndexName -> IndexShardingPolicy -> Item a -> IndexName

250+chooseIxn :: ESVersion v => proxy v -> IndexName v -> IndexShardingPolicy -> Item a -> IndexName v

228−chooseIxn (IndexName ixn) p i =

251+chooseIxn prx ixn p i =

229− IndexName (T.intercalate "-" (ixn:segs))

252+ toIndexName prx (T.intercalate "-" ((fromIndexName prx ixn):segs))

230 where

253 where

231 segs = indexNameSegment A.<$> shardPolicySegs p i

254 segs = indexNameSegment A.<$> shardPolicySegs p i

232

255

@@ -246,19 +269,23 @@ splitTime t = asMins `divMod` 60

246

269

247

270

248-------------------------------------------------------------------------------

271-------------------------------------------------------------------------------

249−data EsScribeSetupError = CouldNotCreateIndex !Reply

272+data EsScribeSetupError = CouldNotCreateIndex !(Response ByteString)

250− | CouldNotCreateMapping !Reply deriving (Typeable, Show)

273+ | CouldNotCreateMapping !(Response ByteString) deriving (Typeable, Show)

251

274

252

275

253instance Exception EsScribeSetupError

276instance Exception EsScribeSetupError

254

277

278+

255-------------------------------------------------------------------------------

279-------------------------------------------------------------------------------

256mkEsScribe

280mkEsScribe

281+ :: forall v. ( ESVersion v

282+ , MonadIO (BH v IO)

283+ )

257− :: EsScribeCfg

284+ => EsScribeCfg v

258− -> BHEnv

285+ -> BHEnv v

259− -> IndexName

286+ -> IndexName v

260 -- ^ Treated as a prefix if index sharding is enabled

287 -- ^ Treated as a prefix if index sharding is enabled

261− -> MappingName

288+ -> MappingName v

262 -> Severity

289 -> Severity

263 -> Verbosity

290 -> Verbosity

264 -> IO Scribe

291 -> IO Scribe

@@ -266,17 +293,17 @@ mkEsScribe cfg@EsScribeCfg {..} env ix mapping sev verb = do

266 q <- newTBMQueueIO $ unEsQueueSize essQueueSize

293 q <- newTBMQueueIO $ unEsQueueSize essQueueSize

267 endSig <- newEmptyMVar

294 endSig <- newEmptyMVar

268

295

269− runBH env $ do

296+ runBH prx env $ do

270− chk <- indexExists ix

297+ chk <- indexExists prx ix

271 -- note that this doesn't update settings. That's not available

298 -- note that this doesn't update settings. That's not available

272 -- through the Bloodhound API yet

299 -- through the Bloodhound API yet

273 unless chk $ void $ do

300 unless chk $ void $ do

274− r1 <- createIndex essIndexSettings ix

301+ r1 <- createIndex prx essIndexSettings ix

275 unless (statusIsSuccessful (responseStatus r1)) $

302 unless (statusIsSuccessful (responseStatus r1)) $

276 liftIO $ throwIO (CouldNotCreateIndex r1)

303 liftIO $ throwIO (CouldNotCreateIndex r1)

277 r2 <- if shardingEnabled

304 r2 <- if shardingEnabled

278− then putTemplate tpl tplName

305+ then putTemplate prx tpl tplName

279− else putMapping ix mapping (baseMapping mapping)

306+ else putMapping prx ix mapping base

280 unless (statusIsSuccessful (responseStatus r2)) $

307 unless (statusIsSuccessful (responseStatus r2)) $

281 liftIO $ throwIO (CouldNotCreateMapping r2)

308 liftIO $ throwIO (CouldNotCreateMapping r2)

282

309

@@ -289,27 +316,31 @@ mkEsScribe cfg@EsScribeCfg {..} env ix mapping sev verb = do

289 mapM_ waitCatch workers

316 mapM_ waitCatch workers

290 putMVar endSig ()

317 putMVar endSig ()

291

318

292− let logger i =

293− when (_itemSeverity i >= sev) $

294− void $ atomically $ tryWriteTBMQueue q (chooseIxn ix essIndexSharding i, itemJson' i)

295 let finalizer = putMVar endSig () >> takeMVar endSig

319 let finalizer = putMVar endSig () >> takeMVar endSig

296− return (Scribe logger finalizer)

320+ return (Scribe (logger q) finalizer)

297 where

321 where

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

298− tplName = TemplateName ixn

327+ tplName = toTemplateName prx ixn

299 shardingEnabled = case essIndexSharding of

328 shardingEnabled = case essIndexSharding of

300 NoIndexSharding -> False

329 NoIndexSharding -> False

301 _ -> True

330 _ -> True

302− tpl = IndexTemplate (TemplatePattern (ixn <> "-*")) (Just essIndexSettings) [toJSON (baseMapping mapping)]

331+ tpl = toIndexTemplate prx (toTemplatePattern prx (ixn <> "-*")) (Just essIndexSettings) [toJSON base]

303− IndexName ixn = ix

332+ base = baseMapping prx mapping

333+ ixn = fromIndexName prx ix

334+ itemJson' :: LogItem a => Item a -> Value

304 itemJson' i

335 itemJson' i

305 | essAnnotateTypes = itemJson verb (TypeAnnotated <$> i)

336 | essAnnotateTypes = itemJson verb (TypeAnnotated <$> i)

306 | otherwise = itemJson verb i

337 | otherwise = itemJson verb i

307

338

308

339

309-------------------------------------------------------------------------------

340-------------------------------------------------------------------------------

310−baseMapping :: MappingName -> Value

341+baseMapping :: ESVersion v => proxy v -> MappingName v -> Value

311−baseMapping (MappingName mn) =

342+baseMapping prx mn =

312− object [ mn .= object ["properties" .= object prs] ]

343+ object [ fromMappingName prx mn .= object ["properties" .= object prs] ]

313 where prs = [ str "thread"

344 where prs = [ str "thread"

314 , str "sev"

345 , str "sev"

315 , str "pid"

346 , 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

341

372

342

373

343-------------------------------------------------------------------------------

374-------------------------------------------------------------------------------

344−mkDocId :: IO DocId

375+mkDocId :: ESVersion v => proxy v -> IO (DocId v)

345−mkDocId = (DocId . T.decodeUtf8 . toASCIIBytes) `fmap` UUID4.nextRandom

376+mkDocId prx = (toDocId prx . T.decodeUtf8 . toASCIIBytes) `fmap` UUID4.nextRandom

346

377

347

378

348-------------------------------------------------------------------------------

379-------------------------------------------------------------------------------

@@ -384,10 +415,11 @@ mkNonZero ctor n

384

415

385-------------------------------------------------------------------------------

416-------------------------------------------------------------------------------

386startWorker

417startWorker

418+ :: forall v. (ESVersion v)

387− :: EsScribeCfg

419+ => EsScribeCfg v

388− -> BHEnv

420+ -> BHEnv v

389− -> MappingName

421+ -> MappingName v

390− -> TBMQueue (IndexName, Value)

422+ -> TBMQueue (IndexName v, Value)

391 -> IO ()

423 -> IO ()

392startWorker EsScribeCfg {..} env mapping q = go

424startWorker EsScribeCfg {..} env mapping q = go

393 where

425 where

@@ -398,13 +430,112 @@ startWorker EsScribeCfg {..} env mapping q = go

398 sendLog ixn v `catchAny` eat

430 sendLog ixn v `catchAny` eat

399 go

431 go

400 Nothing -> return ()

432 Nothing -> return ()

433+ prx :: Typeable.Proxy v

434+ prx = Typeable.Proxy

401− sendLog :: IndexName -> Value -> IO ()

435+ sendLog :: IndexName v -> Value -> IO ()

402 sendLog ixn v = void $ recovering essRetryPolicy [handler] $ const $ do

436 sendLog ixn v = void $ recovering essRetryPolicy [handler] $ const $ do

403− did <- mkDocId

437+ did <- mkDocId prx

404− res <- runBH env $ indexDocument ixn mapping defaultIndexDocumentSettings v did

438+ res <- runBH prx env $ indexDocument prx ixn mapping (defaultIndexDocumentSettings prx) v did

405 return res

439 return res

406 eat _ = return ()

440 eat _ = return ()

407 handler _ = Handler $ \e ->

441 handler _ = Handler $ \e ->

408 case fromException e of

442 case fromException e of

409 Just (_ :: AsyncException) -> return False

443 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

katip-elasticsearch/test/Main.hs+54−36

@@ -22,13 +22,15 @@ import Data.Monoid

22import Data.Scientific

23import Data.Time

24import Data.Time.Calendar.WeekDate

25+import Data.Typeable

25import qualified Data.Vector as V

26import qualified Data.Vector as V

26−import Database.Bloodhound hiding (key)

27+import qualified Database.V1.Bloodhound as V1

27import Network.HTTP.Client

28import Network.HTTP.Client

28import Network.HTTP.Types.Status

29import Network.HTTP.Types.Status

29import Test.QuickCheck.Instances ()

30import Test.QuickCheck.Instances ()

30import Test.Tasty

31import Test.Tasty

31import Test.Tasty.HUnit

32import Test.Tasty.HUnit

33+import Test.Tasty.Options

32import Test.Tasty.QuickCheck

34import Test.Tasty.QuickCheck

33-------------------------------------------------------------------------------

35-------------------------------------------------------------------------------

34import Katip

36import Katip

@@ -37,24 +39,39 @@ import Katip.Scribes.ElasticSearch

39main :: IO ()

41main :: IO ()

40−main = defaultMain $ testGroup "katip-elasticsearch"

42+main = defaultMain $ askOption $ \vers -> testGroup "katip-elasticsearch"

41 [

43 [

42− esTests

44+ esTests vers

43 , typeAnnotatedTests

45 , typeAnnotatedTests

44 , roundToSundayTests

46 , roundToSundayTests

45 ]

47 ]

48-------------------------------------------------------------------------------

50-------------------------------------------------------------------------------

51+data TestWithESVersion = TestV1

52+ | TestV5

53+ deriving (Typeable)

54+

55+

56+instance IsOption TestWithESVersion where

57+ defaultValue = TestV1

58+ parseValue "1" = Just TestV1

59+ parseValue "5" = Just TestV5

60+ parseValue _ = Nothing

61+ optionName = "es-version"

62+ optionHelp = "Version of ES to test against, either 1 or 5, defaulting to 1."

63+

64+

65+-------------------------------------------------------------------------------

49−setupSearch :: (EsScribeCfg -> EsScribeCfg) -> IO Scribe

66+setupSearch :: (EsScribeCfg ESV1 -> EsScribeCfg ESV1) -> IO Scribe

50setupSearch modScribeCfg = do

67setupSearch modScribeCfg = do

51 bh dropESSchema

68 bh dropESSchema

52 mgr <- newManager defaultManagerSettings

69 mgr <- newManager defaultManagerSettings

53− mkEsScribe cfg (mkBHEnv svr mgr) ixn mn DebugS V3

70+ mkEsScribe cfg (V1.mkBHEnv svr mgr) ixn mn DebugS V3

54 where

71 where

55− cfg = modScribeCfg (defaultEsScribeCfg { essAnnotateTypes = True

72+ cfg = modScribeCfg (defaultEsScribeCfgV1 { essAnnotateTypes = True

56− , essIndexSettings = ixs

73+ , essIndexSettings = ixs

57− })

74+ })

60-------------------------------------------------------------------------------

77-------------------------------------------------------------------------------

@@ -71,13 +88,14 @@ withSearch = withSearch' id

73-------------------------------------------------------------------------------

90-------------------------------------------------------------------------------

74−withSearch' :: (EsScribeCfg -> EsScribeCfg) -> (IO Scribe -> TestTree) -> TestTree

91+withSearch' :: (EsScribeCfg ESV1 -> EsScribeCfg ESV1) -> (IO Scribe -> TestTree) -> TestTree

75withSearch' modScribeCfg = withResource (setupSearch modScribeCfg) (const teardownSearch)

92withSearch' modScribeCfg = withResource (setupSearch modScribeCfg) (const teardownSearch)

78-------------------------------------------------------------------------------

95-------------------------------------------------------------------------------

96+--TODO: switch off version

79−esTests :: TestTree

97+esTests :: TestWithESVersion -> TestTree

80−esTests = testGroup "elasticsearch scribe"

98+esTests _ = testGroup "elasticsearch scribe"

81 [

99 [

82 withSearch' (\c -> c { essIndexSharding = NoIndexSharding}) $ \setup -> testCase "it flushes to elasticsearch" $ withTestLogging setup $ \done -> do

100 withSearch' (\c -> c { essIndexSharding = NoIndexSharding}) $ \setup -> testCase "it flushes to elasticsearch" $ withTestLogging setup $ \done -> do

83 $(logT) (ExampleCtx True) mempty InfoS "A test message"

101 $(logT) (ExampleCtx True) mempty InfoS "A test message"

@@ -98,8 +116,8 @@ esTests = testGroup "elasticsearch scribe"

98 $(logT) (ExampleCtx True) mempty InfoS "tomorrow"

116 $(logT) (ExampleCtx True) mempty InfoS "tomorrow"

99 liftIO $ do

117 liftIO $ do

100 void done

118 void done

101− todayLogs <- getLogsByIndex (IndexName "katip-elasticsearch-tests-2016-01-02")

119+ todayLogs <- getLogsByIndex (V1.IndexName "katip-elasticsearch-tests-2016-01-02")

102− tomorrowLogs <- getLogsByIndex (IndexName "katip-elasticsearch-tests-2016-01-03")

120+ tomorrowLogs <- getLogsByIndex (V1.IndexName "katip-elasticsearch-tests-2016-01-03")

103 assertBool ("todayLogs has " <> show (length todayLogs) <> " items") (length todayLogs == 1)

121 assertBool ("todayLogs has " <> show (length todayLogs) <> " items") (length todayLogs == 1)

104 assertBool ("tomorrowLogs has " <> show (length tomorrowLogs) <> " items") (length tomorrowLogs == 1)

122 assertBool ("tomorrowLogs has " <> show (length tomorrowLogs) <> " items") (length tomorrowLogs == 1)

105 let logToday = head todayLogs

123 let logToday = head todayLogs

@@ -116,8 +134,8 @@ esTests = testGroup "elasticsearch scribe"

116 $(logT) (ExampleCtx True) mempty InfoS "tomorrow"

134 $(logT) (ExampleCtx True) mempty InfoS "tomorrow"

117 liftIO $ do

135 liftIO $ do

118 void done

136 void done

119− todayLogs <- getLogsByIndex (IndexName "katip-elasticsearch-tests-2016-02-28") -- rounds back to previous sunday

137+ todayLogs <- getLogsByIndex (V1.IndexName "katip-elasticsearch-tests-2016-02-28") -- rounds back to previous sunday

120− tomorrowLogs <- getLogsByIndex (IndexName "katip-elasticsearch-tests-2016-03-06") -- is on sunday, so uses current date

138+ tomorrowLogs <- getLogsByIndex (V1.IndexName "katip-elasticsearch-tests-2016-03-06") -- is on sunday, so uses current date

121 assertBool ("todayLogs has " <> show (length todayLogs) <> " items") (length todayLogs == 1)

139 assertBool ("todayLogs has " <> show (length todayLogs) <> " items") (length todayLogs == 1)

122 assertBool ("tomorrowLogs has " <> show (length tomorrowLogs) <> " items") (length tomorrowLogs == 1)

140 assertBool ("tomorrowLogs has " <> show (length tomorrowLogs) <> " items") (length tomorrowLogs == 1)

123 let logToday = head todayLogs

141 let logToday = head todayLogs

@@ -235,24 +253,24 @@ getLogs = getLogsByIndex ixn

235

253

236

254

237-------------------------------------------------------------------------------

255-------------------------------------------------------------------------------

238−getLogsByIndex :: IndexName -> IO [Value]

256+getLogsByIndex :: V1.IndexName -> IO [Value]

239getLogsByIndex i = do

257getLogsByIndex i = do

240 r <- bh $ do

258 r <- bh $ do

241− void (refreshIndex i)

259+ void (V1.refreshIndex i)

242− searchByIndex i (mkSearch Nothing Nothing)

260+ V1.searchByIndex i (V1.mkSearch Nothing Nothing)

243 let actualCode = statusCode (responseStatus r)

261 let actualCode = statusCode (responseStatus r)

244 assertBool ("search by " <> show i <> " " <> show actualCode <> " /= 200") (actualCode == 200)

262 assertBool ("search by " <> show i <> " " <> show actualCode <> " /= 200") (actualCode == 200)

245 return $ responseBody r ^.. key "hits" . key "hits" . values

263 return $ responseBody r ^.. key "hits" . key "hits" . values

246

264

247

265

248-------------------------------------------------------------------------------

266-------------------------------------------------------------------------------

249−bh :: BH IO a -> IO a

267+bh :: V1.BH IO a -> IO a

250−bh = withBH defaultManagerSettings svr

268+bh = V1.withBH defaultManagerSettings svr

251

269

252

270

253-------------------------------------------------------------------------------

271-------------------------------------------------------------------------------

254withTestLogging

272withTestLogging

255− :: IO Scribe -> (IO Reply -> KatipT IO b) -> IO b

273+ :: IO Scribe -> (IO V1.Reply -> KatipT IO b) -> IO b

256withTestLogging = withTestLogging' id

274withTestLogging = withTestLogging' id

257

275

258

276

@@ -260,7 +278,7 @@ withTestLogging = withTestLogging' id

260withTestLogging'

278withTestLogging'

261 :: (LogEnv -> LogEnv)

279 :: (LogEnv -> LogEnv)

262 -> IO Scribe

280 -> IO Scribe

263− -> (IO Reply -> KatipT IO b)

281+ -> (IO V1.Reply -> KatipT IO b)

264 -> IO b

282 -> IO b

265withTestLogging' modEnv setup f = do

283withTestLogging' modEnv setup f = do

266 scr <- setup

284 scr <- setup

@@ -268,7 +286,7 @@ withTestLogging' modEnv setup f = do

268 le' <- registerScribe "es" scr defaultScribeSettings le

286 le' <- registerScribe "es" scr defaultScribeSettings le

269 let done' = do

287 let done' = do

270 _ <- closeScribes le'

288 _ <- closeScribes le'

271− bh (refreshIndex ixn)

289+ bh (V1.refreshIndex ixn)

272 runKatipT le' (f done')

290 runKatipT le' (f done')

273 where

291 where

274 ns = Namespace ["katip-test"]

292 ns = Namespace ["katip-test"]

@@ -276,33 +294,33 @@ withTestLogging' modEnv setup f = do

276

294

277

295

278-------------------------------------------------------------------------------

296-------------------------------------------------------------------------------

279−svr :: Server

297+svr :: V1.Server

280−svr = Server "http://localhost:9200"

298+svr = V1.Server "http://localhost:9200"

281

299

282

300

283-------------------------------------------------------------------------------

301-------------------------------------------------------------------------------

284−ixn :: IndexName

302+ixn :: V1.IndexName

285−ixn = IndexName "katip-elasticsearch-tests"

303+ixn = V1.IndexName "katip-elasticsearch-tests"

286

304

287

305

288-------------------------------------------------------------------------------

306-------------------------------------------------------------------------------

289−ixs :: IndexSettings

307+ixs :: V1.IndexSettings

290−ixs = defaultIndexSettings { indexShards = ShardCount 1

308+ixs = V1.defaultIndexSettings { V1.indexShards = V1.ShardCount 1

291− , indexReplicas = ReplicaCount 1}

309+ , V1.indexReplicas = V1.ReplicaCount 1}

292

310

293-------------------------------------------------------------------------------

311-------------------------------------------------------------------------------

294−mn :: MappingName

312+mn :: V1.MappingName

295−mn = MappingName "logs"

313+mn = V1.MappingName "logs"

296

314

297

315

298-------------------------------------------------------------------------------

316-------------------------------------------------------------------------------

299−dropESSchema :: BH IO ()

317+dropESSchema :: V1.BH IO ()

300−dropESSchema = void $ deleteIndex (IndexName "katip-elasticsearch-tests*")

318+dropESSchema = void $ V1.deleteIndex (V1.IndexName "katip-elasticsearch-tests*")

301

319

302

320

303-------------------------------------------------------------------------------

321-------------------------------------------------------------------------------

304−dropESSTemplate :: BH IO ()

322+dropESSTemplate :: V1.BH IO ()

305−dropESSTemplate = void $ deleteTemplate (TemplateName "katip-elasticsearch-tests")

323+dropESSTemplate = void $ V1.deleteTemplate (V1.TemplateName "katip-elasticsearch-tests")

306

324

307

325

308-------------------------------------------------------------------------------

326-------------------------------------------------------------------------------

stack.yaml+2−1

@@ -2,7 +2,8 @@ resolver: lts-8.21

2packages:

3 - katip

4 - katip-elasticsearch

5−extra-deps: []

5+extra-deps:

6+ - bloodhound-0.14.0.0

6flags:

7flags:

7 katip:

8 katip:

8 lib-Werror: true

9 lib-Werror: true