git.iko.soy/typeable/katip
on master help sign in
Add weekly sharding option
a8f098bMichael Xavier
katip-elasticsearch/src/Katip/Scribes/ElasticSearch.hs+20
compare with master
unifiedsplit
@@ -26,6 +26,7 @@ module Katip.Scribes.ElasticSearch
26 -- * Utilities
26 -- * Utilities
27 , mkDocId
27 , mkDocId
28 , module Katip.Scribes.ElasticSearch.Annotations
28 , module Katip.Scribes.ElasticSearch.Annotations
29+ , roundToSunday
29 ) where
30 ) where
30
31
31
32
@@ -50,6 +51,7 @@ import Data.Text (Text)
50import qualified Data.Text as T
51import qualified Data.Text as T
51import qualified Data.Text.Encoding as T
52import qualified Data.Text.Encoding as T
52import Data.Time
53import Data.Time
54+import Data.Time.Calendar.WeekDate
53import Data.Typeable
55import Data.Typeable
54import Data.UUID
56import Data.UUID
55import Database.Bloodhound
57import Database.Bloodhound
@@ -147,6 +149,8 @@ defaultEsScribeCfg = EsScribeCfg {
147-- (e.g. @foo-2016-*@).
149-- (e.g. @foo-2016-*@).
148data IndexShardingPolicy = NoIndexSharding
150data IndexShardingPolicy = NoIndexSharding
149 | MonthlyIndexSharding
151 | MonthlyIndexSharding
152+ | WeeklyIndexSharding
153+ -- ^ A special case of daily which shards to sunday
150 | DailyIndexSharding
154 | DailyIndexSharding
151 | HourlyIndexSharding
155 | HourlyIndexSharding
152 | EveryMinuteIndexSharding
156 | EveryMinuteIndexSharding
@@ -156,6 +160,7 @@ data IndexShardingPolicy = NoIndexSharding
156instance Show IndexShardingPolicy where
160instance Show IndexShardingPolicy where
157 show NoIndexSharding = "NoIndexSharding"
161 show NoIndexSharding = "NoIndexSharding"
158 show MonthlyIndexSharding = "MonthlyIndexSharding"
162 show MonthlyIndexSharding = "MonthlyIndexSharding"
163+ show WeeklyIndexSharding = "WeeklyIndexSharding"
159 show DailyIndexSharding = "DailyIndexSharding"
164 show DailyIndexSharding = "DailyIndexSharding"
160 show HourlyIndexSharding = "HourlyIndexSharding"
165 show HourlyIndexSharding = "HourlyIndexSharding"
161 show EveryMinuteIndexSharding = "EveryMinuteIndexSharding"
166 show EveryMinuteIndexSharding = "EveryMinuteIndexSharding"
@@ -174,6 +179,9 @@ shardPolicySegs NoIndexSharding _ = []
174shardPolicySegs MonthlyIndexSharding Item {..} = [sis y, sis m]
179shardPolicySegs MonthlyIndexSharding Item {..} = [sis y, sis m]
175 where
180 where
176 (y, m, _) = toGregorian (utctDay _itemTime)
181 (y, m, _) = toGregorian (utctDay _itemTime)
182+shardPolicySegs WeeklyIndexSharding Item {..} = [sis y, sis m, sis d]
183+ where
184+ (y, m, d) = toGregorian (roundToSunday (utctDay _itemTime))
177shardPolicySegs DailyIndexSharding Item {..} = [sis y, sis m, sis d]
185shardPolicySegs DailyIndexSharding Item {..} = [sis y, sis m, sis d]
178 where
186 where
179 (y, m, d) = toGregorian (utctDay _itemTime)
187 (y, m, d) = toGregorian (utctDay _itemTime)
@@ -188,6 +196,18 @@ shardPolicySegs EveryMinuteIndexSharding Item {..} = [sis y, sis m, sis d, sis h
188shardPolicySegs (CustomIndexSharding f) i = f i
196shardPolicySegs (CustomIndexSharding f) i = f i
189
197
190
198
199+-------------------------------------------------------------------------------
200+-- | If the given day is sunday, returns the input, otherwise returns
201+-- the previous sunday
202+roundToSunday :: Day -> Day
203+roundToSunday d
204+ | dow == 7 = d
205+ | w > 1 = fromWeekDate y (w - 1) 7
206+ | otherwise = fromWeekDate (y - 1) 53 7
207+ where
208+ (y, w, dow) = toWeekDate d
209+
210+
191-------------------------------------------------------------------------------
211-------------------------------------------------------------------------------
192chooseIxn :: IndexName -> IndexShardingPolicy -> Item a -> IndexName
212chooseIxn :: IndexName -> IndexShardingPolicy -> Item a -> IndexName
193chooseIxn (IndexName ixn) p i =
213chooseIxn (IndexName ixn) p i =
katip-elasticsearch/test/Main.hs+34
@@ -22,6 +22,7 @@ import qualified Data.Map as M
22import Data.Monoid
22import Data.Monoid
23import Data.Scientific
23import Data.Scientific
24import Data.Time
24import Data.Time
25+import Data.Time.Calendar.WeekDate
25import qualified Data.Vector as V
26import qualified Data.Vector as V
26import Database.Bloodhound hiding (key)
27import Database.Bloodhound hiding (key)
27import Network.HTTP.Client
28import Network.HTTP.Client
@@ -41,6 +42,7 @@ main = defaultMain $ testGroup "katip-elasticsearch"
41 [
42 [
42 esTests
43 esTests
43 , typeAnnotatedTests
44 , typeAnnotatedTests
45+ , roundToSundayTests
44 ]
46 ]
45
47
46
48
@@ -105,6 +107,24 @@ esTests = testGroup "elasticsearch scribe"
105 let logTomorrow = head tomorrowLogs
107 let logTomorrow = head tomorrowLogs
106 logToday ^? key "_source" . key "msg" . _String @?= Just "today"
108 logToday ^? key "_source" . key "msg" . _String @?= Just "today"
107 logTomorrow ^? key "_source" . key "msg" . _String @?= Just "tomorrow"
109 logTomorrow ^? key "_source" . key "msg" . _String @?= Just "tomorrow"
110+ , withSearch' (\c -> c { essIndexSharding = WeeklyIndexSharding}) $ \setup -> testCase "weekly index sharding rounds to previous sunday" $ do
111+ let t1 = mkTime 2016 3 5 0 0 0 -- saturday, march 5th
112+ fakeClock <- newTVarIO t1
113+ withTestLogging' (set logEnvTimer (readTVarIO fakeClock)) setup $ \done -> do
114+ $(logT) (ExampleCtx True) mempty InfoS "today"
115+ let t2 = mkTime 2016 3 6 0 0 0 -- sunday march 6th
116+ liftIO (atomically (writeTVar fakeClock t2))
117+ $(logT) (ExampleCtx True) mempty InfoS "tomorrow"
118+ liftIO $ do
119+ void done
120+ todayLogs <- getLogsByIndex (IndexName "katip-elasticsearch-tests-2016-2-28") -- rounds back to previous sunday
121+ tomorrowLogs <- getLogsByIndex (IndexName "katip-elasticsearch-tests-2016-3-6") -- is on sunday, so uses current date
122+ assertBool ("todayLogs has " <> show (length todayLogs) <> " items") (length todayLogs == 1)
123+ assertBool ("tomorrowLogs has " <> show (length tomorrowLogs) <> " items") (length tomorrowLogs == 1)
124+ let logToday = head todayLogs
125+ let logTomorrow = head tomorrowLogs
126+ logToday ^? key "_source" . key "msg" . _String @?= Just "today"
127+ logTomorrow ^? key "_source" . key "msg" . _String @?= Just "tomorrow"
108 ]
128 ]
109
129
110
130
@@ -152,6 +172,20 @@ typeAnnotatedTests = testGroup "TypeAnnotated"
152 ]
172 ]
153
173
154
174
175+-------------------------------------------------------------------------------
176+roundToSundayTests :: TestTree
177+roundToSundayTests = testGroup "roundToSunday"
178+ [
179+ testProperty "always returns a sunday" $ \d ->
180+ getDOW (roundToSunday d) === 7
181+ , testProperty "returns input on sunday" $ \d -> getDOW d == 7 ==>
182+ roundToSunday d === d
183+ , testProperty "goes back a week when not sunday" $ \d -> getDOW d /= 7 ==>
184+ roundToSunday d < d
185+ ]
186+ where
187+ getDOW = view _3 . toWeekDate
188+
155-------------------------------------------------------------------------------
189-------------------------------------------------------------------------------
156exampleValue :: Value
190exampleValue :: Value
157exampleValue = Array $ V.fromList [Null, Object ob]
191exampleValue = Array $ V.fromList [Null, Object ob]