@@ -1,4 +1,5 @@
11{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE RecordWildCards #-}
23{-# LANGUAGE TemplateHaskell #-}
34module Main
45 ( main
@@ -6,12 +7,16 @@ module Main
67
78
89-------------------------------------------------------------------------------
10+import Control.Lens hiding (mapping)
911import Control.Monad
1012import Control.Monad.IO.Class
13+import Data.Aeson
14+import Data.Aeson.Lens
1115import qualified Data.Map as M
1216import Data.Monoid
13−import Database.Bloodhound
14−import Network.HTTP.Client (defaultManagerSettings)
17+import Database.Bloodhound hiding (key)
18+import Network.HTTP.Client
19+import Network.HTTP.Types.Status
1520import Test.Tasty
1621import Test.Tasty.HUnit
1722-------------------------------------------------------------------------------
@@ -45,49 +50,79 @@ teardownSearch (_, finalizer) = do
4550esTests :: IO (Scribe, IO ()) -> TestTree
4651esTests setup = testGroup "elasticsearch scribe"
4752 [
48− testCase "it works" $ withTestLogging setup $ \done -> do
53+ testCase "it flushes to elasticsearch" $ withTestLogging setup $ \done -> do
4954 $(logT) () mempty InfoS "A test message"
5055 liftIO $ do
5156 done
52− print =<< getLogs
53− True @?= False
57+ logs <- getLogs
58+ length logs @?= 1
59+ let l = head logs
60+ l ^? key "_source" . key "msg" . _String @?= Just "A test message"
5461 ]
5562
5663
5764-------------------------------------------------------------------------------
58−getLogs = bh $ searchByIndex ixn $ mkSearch Nothing Nothing
65+getLogs :: IO [Value]
66+getLogs = do
67+ r <- bh $ searchByIndex ixn $ mkSearch Nothing Nothing
68+ statusCode (responseStatus r) @?= 200
69+ return $ responseBody r ^.. key "hits" . key "hits" . values
5970
6071
6172-------------------------------------------------------------------------------
73+bh :: BH IO a -> IO a
6274bh = withBH defaultManagerSettings svr
6375
6476
6577-------------------------------------------------------------------------------
78+withTestLogging
79+ :: IO (Scribe, IO a) -> (IO Reply -> KatipT IO b) -> IO b
6680withTestLogging setup f = do
67− (scribe, done) <- setup
81+ (scr, done) <- setup
6882 le <- initLogEnv ns env
69− runKatipT le { _logEnvScribes = M.singleton "es" scribe} (f done)
83+ let done' = done >> bh (refreshIndex ixn)
84+ runKatipT le { _logEnvScribes = M.singleton "es" scr} (f done')
7085 where
7186 ns = Namespace ["katip-test"]
7287 env = Environment "test"
7388
89+
7490-------------------------------------------------------------------------------
91+svr :: Server
7592svr = Server "http://localhost:9200"
93+
94+
95+-------------------------------------------------------------------------------
96+ixn :: IndexName
7697ixn = IndexName "katip-elasticsearch-tests"
98+
99+
100+-------------------------------------------------------------------------------
101+ixs :: IndexSettings
77102ixs = defaultIndexSettings
103+
104+-------------------------------------------------------------------------------
105+mn :: MappingName
78106mn = MappingName "logs"
107+
108+
109+-------------------------------------------------------------------------------
110+mapping :: ()
79111mapping = () -- ehhh
80112
81113
82114-------------------------------------------------------------------------------
115+recreateESSchema :: BH IO Reply
83116recreateESSchema = dropESSchema >> createESSchema
84117
85118
86119-------------------------------------------------------------------------------
120+dropESSchema :: BH IO ()
87121dropESSchema = void $ deleteIndex ixn
88122
89123
90124-------------------------------------------------------------------------------
125+createESSchema :: BH IO Reply
91126createESSchema = do
92127 createIndex ixs ixn
93128 putMapping ixn mn mapping