git.iko.soy/typeable/katip
on master help sign in
Merge branch 'master' into async-buffer

Conflicts: TODO.org katip-elasticsearch/katip-elasticsearch.cabal katip-elasticsearch/src/Katip/Scribes/ElasticSearch.hs

commitb42d59274223012aad54ba9e15b775a1cff18e75 authorMichael Xavier <michael@michaelxavier.net> dateFri 20 Mar 2015, 09:48 (12 years ago) parentfcace7e8f21fec
7 files changed+138−26
compare with master
unifiedsplit
TODO.org+38−1 katip-elasticsearch/bench/Main.hs+43 katip-elasticsearch/katip-elasticsearch.cabal+20−4 katip-elasticsearch/src/Katip/Scribes/ElasticSearch.hs+20−11 katip/katip.cabal+1 katip/src/Katip/Core.hs+14−10 katip/src/Katip/Monadic.hs+2
TODO.org+38−1
@@ -30,7 +30,7 @@
3030* katip-elasticsearch
3131
3232** DONE Efficient UUID generation (don't use system rng)
33− CLOSED: [2015-03-16 Mon 10:03]
33+ CLOSED: [2015-03-17 Tue 10:27]
3434
3535 Make RNG once, store it behind an mvar and use it in all uuid
3636 generation. Use the rng-utils module for this.
@@ -47,6 +47,19 @@
4747 the size limit is reached, we drop the request instead of blocking
4848 until limit is reached.
4949
50+** TODO Be resilient to server disconnects and crashes
51+ The async buffer method described above certainly helps with this.
52+ In addition, make sure that nothing out of the ordinary happens if
53+ the server is unreachable. Logging should not be an element in any
54+ stack that can potentially induce a crash - that would defeat the
55+ purpose!
56+
57+ This means:
58+ - No slowdowns, no crashes even if server is unreachable
59+ - No file descriptor hogging (tight loop retries, etc.)
60+ - Gently try once in a while to see if the server has become
61+ reachable again
62+
5063** TODO Connection pooling (bloodhound)
5164
5265 Exposing Manager would solve this, as it does internal pooling.
@@ -55,3 +68,27 @@
5568
5669 Seems to be a limitation of http-client that we'll have to live
5770 with for now.
71+
72+
73+* katip-rotated-log
74+
75+** TODO Create a rotated-log scribe
76+
77+ This works just like the built-in Handle scribe, but pushes the log
78+ through the rotated-log packages and therefore rotates files when
79+ they get too large
80+
81+
82+* katip-retry
83+
84+** TODO Implement combinator for creating exception Handler that log to katip
85+
86+ Along the lines of the built-in 'logRetries' in retry, but instead
87+ captures structured information through katip.
88+
89+ Explicitly capture fields to aid in filtering:
90+
91+ - Retry number
92+ - The exception
93+ - The exception type - maybe via Typeable's typeOf?
94+ - Decision result: Crashing vs. Retrying
katip-elasticsearch/bench/Main.hsnew file+43
@@ -0,0 +1,43 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE StandaloneDeriving #-}
4+module Main
5+ ( main
6+ ) where
7+
8+-------------------------------------------------------------------------------
9+import Control.Applicative
10+import Control.DeepSeq
11+import Control.Monad
12+import Criterion.Main
13+import Data.RNG
14+import qualified Data.Text as T
15+import Database.Bloodhound.Types
16+import Numeric
17+-------------------------------------------------------------------------------
18+import Katip.Scribes.ElasticSearch
19+-------------------------------------------------------------------------------
20+
21+main :: IO ()
22+main = do
23+ rng <- mkRNG
24+ defaultMain [mkDocIdBenchmark rng]
25+
26+-------------------------------------------------------------------------------
27+mkDocIdBenchmark :: RNG -> Benchmark
28+mkDocIdBenchmark rng = bgroup "mkDocId"
29+ [ bench "mkDocId (randomIO)" $ nfIO mkDocId
30+ , bench "mkDocId' (shared )" $ nfIO $ mkDocId' rng
31+ ]
32+
33+
34+mkDocId' :: RNG -> IO DocId
35+mkDocId' rng = do
36+ is <- withRNG rng $ \gen -> replicateM len $ mk gen
37+ return . DocId . T.pack . concatMap (flip showHex "") $ is
38+ where
39+ len = 32
40+ mk :: GenIO -> IO Int
41+ mk = uniformR (0,15)
42+
43+deriving instance NFData DocId
katip-elasticsearch/katip-elasticsearch.cabal+20−4
@@ -1,7 +1,5 @@
11name: katip-elasticsearch
22version: 0.1.0.0
3−-- synopsis:
4−-- description:
53license: BSD3
64license-file: LICENSE
75author: Ozgun Ataman
@@ -14,8 +12,6 @@ cabal-version: >=1.10
1412library
1513 exposed-modules:
1614 Katip.Scribes.ElasticSearch
17− -- other-modules:
18− -- other-extensions:
1915 build-depends:
2016 base >=4.6 && <4.7
2117 , katip
@@ -25,5 +21,25 @@ library
2521 , aeson >=0.6 && <0.9
2622 , stm >= 2.4.3 && < 2.5
2723 , async >= 2.0.1.0 && < 2.1
24+ , http-client
25+ , text
2826 hs-source-dirs: src
2927 default-language: Haskell2010
28+ hs-source-dirs: src
29+ default-language: Haskell2010
30+
31+benchmark bench
32+ type: exitcode-stdio-1.0
33+ main-is: Main.hs
34+ hs-source-dirs: bench
35+ default-language: Haskell2010
36+ ghc-options: -O2
37+ build-depends:
38+ base
39+ , katip-elasticsearch
40+ , bloodhound
41+ , deepseq
42+ , criterion >= 0.8 && < 1.0
43+ , rng-utils
44+ , uuid
45+ , text
katip-elasticsearch/src/Katip/Scribes/ElasticSearch.hs+20−11
@@ -12,8 +12,10 @@ import Control.Concurrent.Async
1212import Control.Concurrent.STM
1313import Control.Monad
1414import Data.Aeson
15+import qualified Data.Text.Encoding as T
1516import Data.UUID
1617import Database.Bloodhound
18+import Network.HTTP.Client
1719import System.Random
1820-------------------------------------------------------------------------------
1921import Katip.Core
@@ -22,26 +24,31 @@ import Katip.Core
2224
2325-------------------------------------------------------------------------------
2426mkEsScribe
25− :: Server
27+ :: ManagerSettings
28+ -> Server
2629 -> IndexName
2730 -> MappingName
2831 -> EsQueueSize
2932 -> Severity
3033 -> Verbosity
3134 -> IO Scribe
32−mkEsScribe server ix mapping qs sev verb = do
33− q <- newTBQueueIO $ unEsQueueSize qs
34− worker <- startWorker server ix mapping q
35+mkEsScribe ms server ix mapping qs sev verb = do
36+ q <- newTBQueueIO $ unEsQueueSize qs
37+ withManager ms $ \mgr -> do
38+ let env = BHEnv { bhServer = server
39+ , bhManager = mgr
40+ }
41+ worker <- startWorker env ix mapping q
3542 link worker
36−
37− return $ Scribe $ \ i ->
43+ return $ Scribe $ \ i -> do
44+ did <- mkDocId
3845 when (_itemSeverity i >= sev) $
3946 void $ atomically $ tryWriteTBQueue q (itemJson verb i)
4047
4148
4249-------------------------------------------------------------------------------
4350mkDocId :: IO DocId
44−mkDocId = (DocId . toString) `fmap` randomIO
51+mkDocId = (DocId . T.decodeUtf8 . toASCIIBytes) `fmap` randomIO
4552
4653
4754-------------------------------------------------------------------------------
@@ -58,17 +65,19 @@ mkEsQueueSize n
5865
5966-------------------------------------------------------------------------------
6067startWorker
61− :: Server
68+ :: BHEnv
6269 -> IndexName
6370 -> MappingName
6471 -> TBQueue Value
6572 -> IO (Async ())
66−startWorker server ix mapping q = async $ forever $ do
73+startWorker env ix mapping q = async $ forever $ do
6774 v <- atomically $ readTBQueue q
6875 res <- waitCatch =<< async (sendLog v)
69− when (isLeft res) $ inCaseOfEmergency
76+ when (isLeft res) inCaseOfEmergency
7077 where
71− sendLog v = void $ indexDocument server ix mapping v =<< mkDocId
78+ sendLog v = void $ do
79+ did <- mkDocId
80+ runBH env $ indexDocument ix mapping v did
7281 --TODO reenqueue? drop? would be nice to log but we don't have that context
7382 inCaseOfEmergency = return ()
7483
katip/katip.cabal+1
@@ -50,6 +50,7 @@ library
5050 , monad-control >= 1.0 && < 1.1
5151 , mtl
5252 , transformers-base
53+ , resourcet
5354
5455 hs-source-dirs: src
5556 default-language: Haskell2010
katip/src/Katip/Core.hs+14−10
@@ -22,24 +22,25 @@ import Control.Monad.Trans.Class
2222import Control.Monad.Trans.Either
2323import Control.Monad.Trans.Maybe
2424import Control.Monad.Trans.Reader
25+import Control.Monad.Trans.Resource
2526import Control.Monad.Trans.State
2627import Control.Monad.Trans.Writer
27−import Data.Aeson (ToJSON (..))
28−import qualified Data.Aeson as A
29−import Data.Foldable (foldMap)
30−import qualified Data.HashMap.Strict as HM
28+import Data.Aeson (ToJSON (..))
29+import qualified Data.Aeson as A
30+import Data.Foldable (foldMap)
31+import qualified Data.HashMap.Strict as HM
3132import Data.List
32−import qualified Data.Map.Strict as M
33+import qualified Data.Map.Strict as M
3334import Data.Monoid
3435import Data.String
3536import Data.String.Conv
36−import Data.Text (Text)
37−import qualified Data.Text as T
38−import qualified Data.Text.Lazy.Builder as B
37+import Data.Text (Text)
38+import qualified Data.Text as T
39+import qualified Data.Text.Lazy.Builder as B
3940import Data.Time
40−import GHC.Generics hiding (to)
41+import GHC.Generics hiding (to)
4142import Language.Haskell.TH
42−import qualified Language.Haskell.TH.Syntax as TH
43+import qualified Language.Haskell.TH.Syntax as TH
4344import Network.HostName
4445import System.Posix
4546-------------------------------------------------------------------------------
@@ -337,6 +338,9 @@ instance Katip m => Katip (StateT s m) where
337338instance (Katip m, Monoid s) => Katip (WriterT s m) where
338339 getLogEnv = lift getLogEnv
339340
341+instance (Katip m) => Katip (ResourceT m) where
342+ getLogEnv = lift getLogEnv
343+
340344
341345-------------------------------------------------------------------------------
342346-- | A concrete monad you can use to run logging actions.
katip/src/Katip/Monadic.hs+2
@@ -54,6 +54,7 @@ import Control.Monad.Trans.Identity (IdentityT)
5454import Control.Monad.Trans.List (ListT)
5555import Control.Monad.Trans.Maybe (MaybeT)
5656import Control.Monad.Trans.Reader (ReaderT (..), runReaderT)
57+import Control.Monad.Trans.Resource (ResourceT)
5758import Control.Monad.Trans.RWS (RWST)
5859import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST)
5960import Control.Monad.Trans.State (StateT)
@@ -126,6 +127,7 @@ TRANS(MaybeT)
126127TRANS(EitherT e)
127128TRANS(ListT)
128129TRANS(ReaderT r)
130+TRANS(ResourceT)
129131TRANS(Strict.StateT s)
130132TRANS(StateT s)
131133TRANS_CTX(Error e, ErrorT e)