git.iko.soy/typeable/katip
on master help sign in
First green test on elasticsearch!
9ac4830Michael Xavier
katip-elasticsearch/katip-elasticsearch.cabal+5
compare with master
unifiedsplit
@@ -69,4 +69,9 @@ test-suite test
69 , tasty-hunit
69 , tasty-hunit
70 , containers
70 , containers
71 , transformers
71 , transformers
72+ , lens
73+ , lens-aeson
74+ , text
75+ , http-types
76+ , aeson
72
77
katip-elasticsearch/test/Main.hs+43−8
@@ -1,4 +1,5 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE TemplateHaskell #-}
3{-# LANGUAGE TemplateHaskell #-}
3module Main
4module Main
4 ( main
5 ( main
@@ -6,12 +7,16 @@ module Main
6
7
7
8
8-------------------------------------------------------------------------------
9-------------------------------------------------------------------------------
10+import Control.Lens hiding (mapping)
9import Control.Monad
11import Control.Monad
10import Control.Monad.IO.Class
12import Control.Monad.IO.Class
13+import Data.Aeson
14+import Data.Aeson.Lens
11import qualified Data.Map as M
15import qualified Data.Map as M
12import Data.Monoid
16import Data.Monoid
13−import Database.Bloodhound
17+import Database.Bloodhound hiding (key)
14−import Network.HTTP.Client (defaultManagerSettings)
18+import Network.HTTP.Client
19+import Network.HTTP.Types.Status
15import Test.Tasty
20import Test.Tasty
16import Test.Tasty.HUnit
21import Test.Tasty.HUnit
17-------------------------------------------------------------------------------
22-------------------------------------------------------------------------------
@@ -45,49 +50,79 @@ teardownSearch (_, finalizer) = do
45esTests :: IO (Scribe, IO ()) -> TestTree
50esTests :: IO (Scribe, IO ()) -> TestTree
46esTests setup = testGroup "elasticsearch scribe"
51esTests setup = testGroup "elasticsearch scribe"
47 [
52 [
48− testCase "it works" $ withTestLogging setup $ \done -> do
53+ testCase "it flushes to elasticsearch" $ withTestLogging setup $ \done -> do
49 $(logT) () mempty InfoS "A test message"
54 $(logT) () mempty InfoS "A test message"
50 liftIO $ do
55 liftIO $ do
51 done
56 done
52− print =<< getLogs
57+ logs <- getLogs
53− True @?= False
58+ length logs @?= 1
59+ let l = head logs
60+ l ^? key "_source" . key "msg" . _String @?= Just "A test message"
54 ]
61 ]
55
62
56
63
57-------------------------------------------------------------------------------
64-------------------------------------------------------------------------------
65+getLogs :: IO [Value]
66+getLogs = do
58−getLogs = bh $ searchByIndex ixn $ mkSearch Nothing Nothing
67+ r <- bh $ searchByIndex ixn $ mkSearch Nothing Nothing
68+ statusCode (responseStatus r) @?= 200
69+ return $ responseBody r ^.. key "hits" . key "hits" . values
59
70
60
71
61-------------------------------------------------------------------------------
72-------------------------------------------------------------------------------
73+bh :: BH IO a -> IO a
62bh = withBH defaultManagerSettings svr
74bh = withBH defaultManagerSettings svr
63
75
64
76
65-------------------------------------------------------------------------------
77-------------------------------------------------------------------------------
78+withTestLogging
79+ :: IO (Scribe, IO a) -> (IO Reply -> KatipT IO b) -> IO b
66withTestLogging setup f = do
80withTestLogging setup f = do
67− (scribe, done) <- setup
81+ (scr, done) <- setup
68 le <- initLogEnv ns env
82 le <- initLogEnv ns env
83+ let done' = done >> bh (refreshIndex ixn)
69− runKatipT le { _logEnvScribes = M.singleton "es" scribe} (f done)
84+ runKatipT le { _logEnvScribes = M.singleton "es" scr} (f done')
70 where
85 where
71 ns = Namespace ["katip-test"]
86 ns = Namespace ["katip-test"]
72 env = Environment "test"
87 env = Environment "test"
73
88
89+
74-------------------------------------------------------------------------------
90-------------------------------------------------------------------------------
91+svr :: Server
75svr = Server "http://localhost:9200"
92svr = Server "http://localhost:9200"
93+
94+
95+-------------------------------------------------------------------------------
96+ixn :: IndexName
76ixn = IndexName "katip-elasticsearch-tests"
97ixn = IndexName "katip-elasticsearch-tests"
98+
99+
100+-------------------------------------------------------------------------------
101+ixs :: IndexSettings
77ixs = defaultIndexSettings
102ixs = defaultIndexSettings
103+
104+-------------------------------------------------------------------------------
105+mn :: MappingName
78mn = MappingName "logs"
106mn = MappingName "logs"
107+
108+
109+-------------------------------------------------------------------------------
110+mapping :: ()
79mapping = () -- ehhh
111mapping = () -- ehhh
80
112
81
113
82-------------------------------------------------------------------------------
114-------------------------------------------------------------------------------
115+recreateESSchema :: BH IO Reply
83recreateESSchema = dropESSchema >> createESSchema
116recreateESSchema = dropESSchema >> createESSchema
84
117
85
118
86-------------------------------------------------------------------------------
119-------------------------------------------------------------------------------
120+dropESSchema :: BH IO ()
87dropESSchema = void $ deleteIndex ixn
121dropESSchema = void $ deleteIndex ixn
88
122
89
123
90-------------------------------------------------------------------------------
124-------------------------------------------------------------------------------
125+createESSchema :: BH IO Reply
91createESSchema = do
126createESSchema = do
92 createIndex ixs ixn
127 createIndex ixs ixn
93 putMapping ixn mn mapping
128 putMapping ixn mn mapping