git.iko.soy/typeable/katip
on master help sign in
WIP test suite
40e19feMichael Xavier
katip-elasticsearch/katip-elasticsearch.cabal+17
compare with master
unifiedsplit
@@ -53,3 +53,20 @@ benchmark bench
53 , rng-utils
53 , rng-utils
54 , uuid
54 , uuid
55 , text
55 , text
56+
57+test-suite test
58+ type: exitcode-stdio-1.0
59+ main-is: Main.hs
60+ hs-source-dirs: test
61+ default-language: Haskell2010
62+ build-depends:
63+ katip-elasticsearch
64+ , katip
65+ , http-client
66+ , bloodhound
67+ , base
68+ , tasty
69+ , tasty-hunit
70+ , containers
71+ , transformers
72+
katip-elasticsearch/src/Katip/Scribes/ElasticSearch.hs+10−7
@@ -96,14 +96,12 @@ mkEsScribe cfg@EsScribeCfg {..} server ix mapping sev verb = do
96 _ <- async $ do
96 _ <- async $ do
97 takeMVar endSig
97 takeMVar endSig
98 atomically $ closeTBMQueue q
98 atomically $ closeTBMQueue q
99− -- wait for queue to empty
100− atomically $ check =<< isEmptyTBMQueue q
101− mapM_ cancel workers
99+ mapM_ wait workers
102 putMVar endSig ()
100 putMVar endSig ()
103
101
104 let scribe = Scribe $ \ i ->
102 let scribe = Scribe $ \ i ->
105 when (_itemSeverity i >= sev) $
103 when (_itemSeverity i >= sev) $
106− void $ atomically $ tryWriteTBMQueue q (itemJson verb i)
104+ void $ atomically $ tryWriteTBMQueue q (itemJson verb i)
107 let finalizer = putMVar endSig () >> takeMVar endSig
105 let finalizer = putMVar endSig () >> takeMVar endSig
108 return (scribe, finalizer)
106 return (scribe, finalizer)
109
107
@@ -158,10 +156,15 @@ startWorker
158 -> MappingName
156 -> MappingName
159 -> TBMQueue Value
157 -> TBMQueue Value
160 -> IO ()
158 -> IO ()
161−startWorker EsScribeCfg {..} env ix mapping q = forever $ do
159+startWorker EsScribeCfg {..} env ix mapping q = go -- manual recursion here. is this a space leak
162− v <- atomically $ readTBMQueue q
163− sendLog v `catchAny` eat
164 where
160 where
161+ go = do
162+ v <- atomically $ readTBMQueue q
163+ case v of
164+ Just v' -> do
165+ sendLog v' `catchAny` eat
166+ go
167+ Nothing -> return ()
165 sendLog v = void $ recovering essRetryPolicy [handler] $ do
168 sendLog v = void $ recovering essRetryPolicy [handler] $ do
166 did <- mkDocId
169 did <- mkDocId
167 runBH env $ indexDocument ix mapping v did
170 runBH env $ indexDocument ix mapping v did
katip-elasticsearch/test/Main.hsnew file+93
@@ -0,0 +1,93 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE TemplateHaskell #-}
3+module Main
4+ ( main
5+ ) where
6+
7+
8+-------------------------------------------------------------------------------
9+import Control.Monad
10+import Control.Monad.IO.Class
11+import qualified Data.Map as M
12+import Data.Monoid
13+import Database.Bloodhound
14+import Network.HTTP.Client (defaultManagerSettings)
15+import Test.Tasty
16+import Test.Tasty.HUnit
17+-------------------------------------------------------------------------------
18+import Katip
19+import Katip.Scribes.ElasticSearch
20+-------------------------------------------------------------------------------
21+
22+
23+main :: IO ()
24+main = defaultMain $ testGroup "katip-elasticsearch"
25+ [
26+ withResource setupSearch teardownSearch esTests
27+ ]
28+
29+
30+-------------------------------------------------------------------------------
31+setupSearch :: IO (Scribe, IO ())
32+setupSearch = do
33+ bh recreateESSchema
34+ mkEsScribe defaultEsScribeCfg svr ixn mn DebugS V3
35+
36+
37+-------------------------------------------------------------------------------
38+teardownSearch :: (Scribe, IO ()) -> IO ()
39+teardownSearch (_, finalizer) = do
40+ finalizer
41+ bh dropESSchema
42+
43+
44+-------------------------------------------------------------------------------
45+esTests :: IO (Scribe, IO ()) -> TestTree
46+esTests setup = testGroup "elasticsearch scribe"
47+ [
48+ testCase "it works" $ withTestLogging setup $ \done -> do
49+ $(logT) () mempty InfoS "A test message"
50+ liftIO $ do
51+ done
52+ print =<< getLogs
53+ True @?= False
54+ ]
55+
56+
57+-------------------------------------------------------------------------------
58+getLogs = bh $ searchByIndex ixn $ mkSearch Nothing Nothing
59+
60+
61+-------------------------------------------------------------------------------
62+bh = withBH defaultManagerSettings svr
63+
64+
65+-------------------------------------------------------------------------------
66+withTestLogging setup f = do
67+ (scribe, done) <- setup
68+ le <- initLogEnv ns env
69+ runKatipT le { _logEnvScribes = M.singleton "es" scribe} (f done)
70+ where
71+ ns = Namespace ["katip-test"]
72+ env = Environment "test"
73+
74+-------------------------------------------------------------------------------
75+svr = Server "http://localhost:9200"
76+ixn = IndexName "katip-elasticsearch-tests"
77+ixs = defaultIndexSettings
78+mn = MappingName "logs"
79+mapping = () -- ehhh
80+
81+
82+-------------------------------------------------------------------------------
83+recreateESSchema = dropESSchema >> createESSchema
84+
85+
86+-------------------------------------------------------------------------------
87+dropESSchema = void $ deleteIndex ixn
88+
89+
90+-------------------------------------------------------------------------------
91+createESSchema = do
92+ createIndex ixs ixn
93+ putMapping ixn mn mapping